Here it is, feel free to change: http://hackage.haskell.org/trac/ghc/ticket/4470
I have added the core for the sub-optimal function 'f'. Criterion benchmarks are there, too. It doesn't make much of a difference for this case -- I'd guess because everything fits into registers here, anyway. Gruss, Christian On 11/04/2010 09:42 AM, Simon Peyton-Jones wrote: > Interesting. What would it look like in Core? Anyone care to make a ticket? > > S > > | -----Original Message----- > | From: [email protected] > [mailto:glasgow-haskell-users- > | [email protected]] On Behalf Of Roman Leshchinskiy > | Sent: 03 November 2010 10:55 > | To: Christian Hoener zu Siederdissen > | Cc: [email protected] > | Subject: Re: Loop optimisation with identical counters > | > | LLVM doesn't eliminate the counters. FWIW, fixing this would improve > performance of > | stream fusion code quite a bit. It's very easy to do in Core. > | > | Roman > | > | On 3 Nov 2010, at 10:45, Christian Hoener zu Siederdissen > | <[email protected]> wrote: > | > | > Thanks, I'll do some measurements on this with ghc7. > | > > | > Gruss, > | > Christian > | > > | > On 11/02/2010 01:23 PM, Simon Marlow wrote: > | >> On 02/11/2010 08:17, Christian Höner zu Siederdissen wrote: > | >>> Hi, > | >>> > | >>> is the following problem a job for ghc or the code generation backend > | >>> (llvm)? > | >>> > | >>> We are given this program: > | >>> > | >>> {-# LANGUAGE BangPatterns #-} > | >>> > | >>> module Main where > | >>> > | >>> f :: Int -> Int -> Int -> Int -> Int > | >>> f !i !j !s !m > | >>> | i == 0 = s+m > | >>> | otherwise = f (i-1) (j-1) (s + i+1) (m + j*5) > | >>> > | >>> g :: Int -> Int > | >>> g !k = f k k 0 0 > | >>> > | >>> > | >>> ff :: Int -> Int -> Int -> Int > | >>> ff !i !s !m > | >>> | i == 0 = s+m > | >>> | otherwise = ff (i-1) (s + i+1) (m + i*5) > | >>> > | >>> gg :: Int -> Int > | >>> gg !k = ff k 0 0 > | >>> > | >>> main = do > | >>> print $ g 20 > | >>> print $ gg 20 > | >>> > | >>> > | >>> Here, 'f' and 'g' are a representation of the code I have. Both > counters > | >>> 'i' and 'j' in 'f' count from the same value with the same step size > and > | >>> terminate at the same time but are not reduced to just one counter. Can > | >>> I reasonably expect this to be done by the code generator? > | >>> 'ff' represents what I would like to see. > | >> > | >> GHC doesn't have any optimisations that would do this currently, > | >> although it's possible that LLVM's loop optimisations might do this on > | >> the generated code for f. > | >> > | >> Cheers, > | >> Simon > | >> > | >> > | >> > | >>> Btw. look at the core, to see that indeed 'f' keep four arguments. > | >>> Functions like 'f' are a result of vector-fusion at work but can be > | >>> written by oneself as well. The point is that if 'f' gets reduced to > | >>> 'ff' then I can have this: > | >>> > | >>> fun k = zipWith (+) (map f1 $ mkIdxs k) (map f2 $ mkIdxs k) > | >>> > | >>> which makes for nicer code sometimes; but before rewriting I wanted to > | >>> ask if that kills performance. > | >>> > | >>> > | >>> Thanks, > | >>> Christian > | >>> > | >>> > | >>> > | >>> _______________________________________________ > | >>> Glasgow-haskell-users mailing list > | >>> [email protected] > | >>> http://www.haskell.org/mailman/listinfo/glasgow-haskell-users > | >> > | > > | > _______________________________________________ > | > Glasgow-haskell-users mailing list > | > [email protected] > | > http://www.haskell.org/mailman/listinfo/glasgow-haskell-users > | _______________________________________________ > | Glasgow-haskell-users mailing list > | [email protected] > | http://www.haskell.org/mailman/listinfo/glasgow-haskell-users > _______________________________________________ Glasgow-haskell-users mailing list [email protected] http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
