foldl as foldr to get list fusion
Bas van Dijk
v.dijk.bas at gmail.com
Fri Oct 14 02:00:39 CEST 2011
Hello,
Is there any reason other than history that foldl and foldl' are not
defined in terms of foldr?
If we define them in terms of foldr like:
foldl f z xs = foldr (\x y -> \z' -> let z'' = z' `f` x in y z'') id xs z
{-# INLINE foldl #-}
foldl' f z xs = foldr (\x y -> \z' -> let !z'' = z' `f` x in y z'') id xs z
{-# INLINE foldl' #-}
we can benefit from list fusion.
For example if we define sum as:
sum :: Num a => [a] -> a
sum = foldl (+) 0
then building the following program with -O2:
fuse = sum (replicate 1000000 1 ++ replicate 5000 1 :: [Int])
yields the following totally fused core:
fuse :: Int
fuse = case $wxs 1000000 0 of ww_ssn {
__DEFAULT -> I# ww_ssn
}
$wxs :: Int# -> Int# -> Int#
$wxs =
\ (w_ssg :: Int#) (ww_ssj :: Int#) ->
case <=# w_ssg 1 of _ {
False -> $wxs (-# w_ssg 1) (+# ww_ssj 1);
True -> $wxs1_rsB 5000 (+# ww_ssj 1)
}
$wxs1_rsB :: Int# -> Int# -> Int#
$wxs1_rsB =
\ (w_ss5 :: Int#) (ww_ss8 :: Int#) ->
case <=# w_ss5 1 of _ {
False -> $wxs1_rsB (-# w_ss5 1) (+# ww_ss8 1);
True -> +# ww_ss8 1
}
Regards,
Bas
More information about the Libraries
mailing list