[commit: packages/base] wip/T7994: Implement foldl with foldr (493a35d)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/base

On branch  : wip/T7994
Link       : http://ghc.haskell.org/trac/ghc/changeset/493a35d42773331c414a9dd01e2ce696d2fe954c/base

>---------------------------------------------------------------

commit 493a35d42773331c414a9dd01e2ce696d2fe954c
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.


>---------------------------------------------------------------

493a35d42773331c414a9dd01e2ce696d2fe954c
 Data/List.hs |   31 ++++++-------------------------
 GHC/List.lhs |   10 ++++------
 2 files changed, 10 insertions(+), 31 deletions(-)

diff --git a/Data/List.hs b/Data/List.hs
index 130ceb2..987ae17 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,8 @@ 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
 
 -- | 'foldl1' is a variant of 'foldl' that has no starting value argument,
 -- and thus must be applied to non-empty lists.
@@ -1008,32 +1006,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..b5b8e08 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,9 @@ 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
 
 -- | 'scanl' is similar to 'foldl', but returns a list of successive
 -- reduced values from the left: