[commit: ghc] master: Use oneShot in the definition of foldl etc. (072259c)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/072259c78f77d6fe7c36755ebe0123e813c34457/ghc

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

commit 072259c78f77d6fe7c36755ebe0123e813c34457
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Sat Oct 25 12:27:06 2014 +0200

    Use oneShot in the definition of foldl etc.
    
    This increases the chance of good code after fusing a left fold. See
    ticket #7994 and the new Note [Left folds via right fold]
    
    Differential Revision: https://phabricator.haskell.org/D393


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

072259c78f77d6fe7c36755ebe0123e813c34457
 libraries/base/Data/OldList.hs |  6 ++++--
 libraries/base/GHC/List.lhs    | 37 ++++++++++++++++++++++++++-----------
 2 files changed, 30 insertions(+), 13 deletions(-)

diff --git a/libraries/base/Data/OldList.hs b/libraries/base/Data/OldList.hs
index 00bc660..e1de19a 100644
--- a/libraries/base/Data/OldList.hs
+++ b/libraries/base/Data/OldList.hs
@@ -522,9 +522,11 @@ pairWithNil x = (x, [])
 
 mapAccumLF :: (acc -> x -> (acc, y)) -> x -> (acc -> (acc, [y])) -> acc -> (acc, [y])
 {-# INLINE [0] mapAccumLF #-}
-mapAccumLF f = \x r s -> let (s', y)   = f s x
+mapAccumLF f = \x r -> oneShot (\s ->
+                         let (s', y)   = f s x
                              (s'', ys) = r s'
-                         in (s'', y:ys)
+                         in (s'', y:ys))
+  -- See Note [Left folds via right fold]
 
 
 -- | The 'mapAccumR' function behaves like a combination of 'map' and
diff --git a/libraries/base/GHC/List.lhs b/libraries/base/GHC/List.lhs
index 6a93033..da4c386 100644
--- a/libraries/base/GHC/List.lhs
+++ b/libraries/base/GHC/List.lhs
@@ -187,10 +187,26 @@ filterFB c p x r | p x       = x `c` r
 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.
+  foldr (\(v::a) (fn::b->b) -> oneShot (\(z::b) -> fn (k z v))) (id :: b -> b) xs z0
+  -- See Note [Left folds via right fold]
+
+{-
+Note [Left folds via right fold]
+
+Implementing foldl et. al. via foldr is only a good idea if the compiler can
+optimize the resulting code (eta-expand the recursive "go"). See #7994.
+We hope that one of the two measure kick in:
+
+   * Call Arity (-fcall-arity, enabled by default) eta-expands it if it can see
+     all calls and determine that the arity is large.
+   * The oneShot annotation gives a hint to the regular arity analysis that
+     it may assume that the lambda is called at most once.
+     See [One-shot lambdas] in CoreArity and especially [Eta expanding thunks]
+     in CoreArity.
+
+The oneShot annotations used in this module are correct, as we only use them in
+argumets to foldr, where we know how the arguments are called.
+-}
 
 -- ----------------------------------------------------------------------------
 
@@ -198,11 +214,8 @@ foldl k z0 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) -> 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
+  foldr (\(v::a) (fn::b->b) -> oneShot (\(z::b) -> z `seq` fn (k z v))) (id :: b -> b) xs z0
+  -- See Note [Left folds via right fold]
 
 -- | 'foldl1' is a variant of 'foldl' that has no starting value argument,
 -- and thus must be applied to non-empty lists.
@@ -258,7 +271,8 @@ scanl                   = scanlGo
 
 {-# INLINE [0] scanlFB #-}
 scanlFB :: (b -> a -> b) -> (b -> c -> c) -> a -> (b -> c) -> b -> c
-scanlFB f c = \b g x -> let b' = f x b in b' `c` g b'
+scanlFB f c = \b g -> oneShot (\x -> let b' = f x b in b' `c` g b')
+  -- See Note [Left folds via right fold]
 
 {-# INLINE [0] constScanl #-}
 constScanl :: a -> b -> a
@@ -295,7 +309,8 @@ scanl' = scanlGo'
 
 {-# INLINE [0] scanlFB' #-}
 scanlFB' :: (b -> a -> b) -> (b -> c -> c) -> a -> (b -> c) -> b -> c
-scanlFB' f c = \b g x -> let !b' = f x b in b' `c` g b'
+scanlFB' f c = \b g -> oneShot (\x -> let !b' = f x b in b' `c` g b')
+  -- See Note [Left folds via right fold]
 
 {-# INLINE [0] flipSeqScanl' #-}
 flipSeqScanl' :: a -> b -> a