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
