[commit: packages/base] master: Implement foldl with foldr (b63face)
git at git.haskell.org
git at git.haskell.org
Mon Feb 10 13:52:33 UTC 2014
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:
More information about the ghc-commits
mailing list