[commit: packages/base] master: Implement foldl with foldr (b63face)
Simon Marlow
marlowsd at gmail.com
Mon Feb 17 10:56:49 UTC 2014
Ah, I realise it's ok so long as the original definition of foldl/foldl'
gets optimised to the right thing. If that's the case just ignore me.
Cheers,
Simon
On 17/02/2014 10:22, Simon Marlow wrote:
> This worries me a bit. If foldl isn't inlined, I get a less efficient
> version, so it has to be inlined everywhere. So -O0 code gets worse,
> and binary sizes for -O1+ get bigger - foldl, sum, and product are now
> INLINE.
>
> What I'm arguing is that we should have more flexibility to *not* inline
> things (INLINABLE is much better than INLINE), and when not inlining
> things we should be calling an efficient version of the function. This
> is why map is not defined in terms of foldr, for instance.
>
> Cheers,
> Simon
>
> On 10/02/2014 13:52, git at git.haskell.org wrote:
>> Repository : ssh://git@git.haskell.org/base
>>
>> On branch : master
>> Link :
>> http://ghc.haskell.org/trac/ghc/changeset/b63facef165b957183b65604ef99b2b8574747a5/base
>>
>>
>>> ---------------------------------------------------------------
>>
>> commit b63facef165b957183b65604ef99b2b8574747a5
>> Author: Joachim Breitner <mail at joachim-breitner.de>
>> Date: Tue Jan 28 14:31:05 2014 +0100
>>
>> Implement foldl with foldr
>>
>> together with the call arity analysis and the following patch
>> (about inlining
>> maximum), we get nice benefits from fusing foldl and foldl' with
>> good
>> producers:
>>
>> Min -0.1% -74.5% -6.8%
>> -8.3% -50.0%
>> Max +0.2% 0.0% +38.5%
>> +38.5% 0.0%
>> Geometric Mean -0.0% -4.1% +7.7%
>> +7.7% -0.8%
>>
>> Because this depends on a compiler optimisation, we have to watch
>> out for cases
>> where this is not an improvements, and whether they occur in the
>> wild.
>>
>>
>>> ---------------------------------------------------------------
>>
>> b63facef165b957183b65604ef99b2b8574747a5
>> Data/List.hs | 34 +++++++++-------------------------
>> GHC/List.lhs | 13 +++++++------
>> 2 files changed, 16 insertions(+), 31 deletions(-)
>>
>> diff --git a/Data/List.hs b/Data/List.hs
>> index 130ceb2..4796055 100644
>> --- a/Data/List.hs
>> +++ b/Data/List.hs
>> @@ -1,5 +1,5 @@
>> {-# LANGUAGE Trustworthy #-}
>> -{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-}
>> +{-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables, MagicHash #-}
>>
>>
>> -----------------------------------------------------------------------------
>>
>> -- |
>> @@ -989,10 +989,11 @@ unfoldr f b =
>> --
>> -----------------------------------------------------------------------------
>>
>>
>> -- | A strict version of 'foldl'.
>> -foldl' :: (b -> a -> b) -> b -> [a] -> b
>> -foldl' f z0 xs0 = lgo z0 xs0
>> - where lgo z [] = z
>> - lgo z (x:xs) = let z' = f z x in z' `seq` lgo z' xs
>> +foldl' :: forall a b . (b -> a -> b) -> b -> [a] -> b
>> +foldl' k z0 xs = foldr (\(v::a) (fn::b->b) (z::b) -> z `seq` fn (k z
>> v)) (id :: b -> b) xs z0
>> +-- Implementing foldl' via foldr is only a good idea if the compiler
>> can optimize
>> +-- the resulting code (eta-expand the recursive "go"), so this needs
>> -fcall-arity!
>> +-- Also see #7994
>>
>> -- | 'foldl1' is a variant of 'foldl' that has no starting value
>> argument,
>> -- and thus must be applied to non-empty lists.
>> @@ -1008,32 +1009,15 @@ foldl1' _ [] = errorEmptyList
>> "foldl1'"
>> --
>> -----------------------------------------------------------------------------
>>
>> -- List sum and product
>>
>> -{-# SPECIALISE sum :: [Int] -> Int #-}
>> -{-# SPECIALISE sum :: [Integer] -> Integer #-}
>> -{-# INLINABLE sum #-}
>> -{-# SPECIALISE product :: [Int] -> Int #-}
>> -{-# SPECIALISE product :: [Integer] -> Integer #-}
>> -{-# INLINABLE product #-}
>> --- We make 'sum' and 'product' inlinable so that we get specialisations
>> --- at other types. See, for example, Trac #7507.
>> -
>> -- | The 'sum' function computes the sum of a finite list of numbers.
>> sum :: (Num a) => [a] -> a
>> -- | The 'product' function computes the product of a finite list of
>> numbers.
>> product :: (Num a) => [a] -> a
>> -#ifdef USE_REPORT_PRELUDE
>> +
>> +{-# INLINE sum #-}
>> sum = foldl (+) 0
>> +{-# INLINE product #-}
>> product = foldl (*) 1
>> -#else
>> -sum l = sum' l 0
>> - where
>> - sum' [] a = a
>> - sum' (x:xs) a = sum' xs (a+x)
>> -product l = prod l 1
>> - where
>> - prod [] a = a
>> - prod (x:xs) a = prod xs (a*x)
>> -#endif
>>
>> --
>> -----------------------------------------------------------------------------
>>
>> -- Functions on strings
>> diff --git a/GHC/List.lhs b/GHC/List.lhs
>> index b7b78c7..e004ded 100644
>> --- a/GHC/List.lhs
>> +++ b/GHC/List.lhs
>> @@ -1,6 +1,6 @@
>> \begin{code}
>> {-# LANGUAGE Trustworthy #-}
>> -{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-}
>> +{-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables, MagicHash #-}
>> {-# OPTIONS_HADDOCK hide #-}
>>
>>
>> -----------------------------------------------------------------------------
>>
>> @@ -178,11 +178,12 @@ filterFB c p x r | p x = x `c` r
>> -- can be inlined, and then (often) strictness-analysed,
>> -- and hence the classic space leak on foldl (+) 0 xs
>>
>> -foldl :: (b -> a -> b) -> b -> [a] -> b
>> -foldl f z0 xs0 = lgo z0 xs0
>> - where
>> - lgo z [] = z
>> - lgo z (x:xs) = lgo (f z x) xs
>> +foldl :: forall a b. (b -> a -> b) -> b -> [a] -> b
>> +{-# INLINE foldl #-}
>> +foldl k z0 xs = foldr (\(v::a) (fn::b->b) (z::b) -> fn (k z v)) (id
>> :: b -> b) xs z0
>> +-- Implementing foldl via foldr is only a good idea if the compiler
>> can optimize
>> +-- the resulting code (eta-expand the recursive "go"), so this needs
>> -fcall-arity!
>> +-- Also see #7994
>>
>> -- | 'scanl' is similar to 'foldl', but returns a list of successive
>> -- reduced values from the left:
>>
>> _______________________________________________
>> ghc-commits mailing list
>> ghc-commits at haskell.org
>> http://www.haskell.org/mailman/listinfo/ghc-commits
>>
More information about the ghc-devs
mailing list