[commit: ghc] wip/validate-T9355: Make scanr a good producer and consumer (7fdedf0)

[git at git.haskell.org]

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

On branch  : wip/validate-T9355
Link       : http://ghc.haskell.org/trac/ghc/changeset/7fdedf05b2d267dda6549e71d5a9da23110c3881/ghc

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

commit 7fdedf05b2d267dda6549e71d5a9da23110c3881
Author: David Feuer <David.Feuer at gmail.com>
Date:   Wed Oct 1 15:24:43 2014 +0200

    Make scanr a good producer and consumer
    
    This fixes #9355.


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

7fdedf05b2d267dda6549e71d5a9da23110c3881
 libraries/base/GHC/List.lhs | 18 ++++++++++++++++++
 libraries/base/changelog.md |  2 ++
 2 files changed, 20 insertions(+)

diff --git a/libraries/base/GHC/List.lhs b/libraries/base/GHC/List.lhs
index 8c8e4bb..51f68ab 100644
--- a/libraries/base/GHC/List.lhs
+++ b/libraries/base/GHC/List.lhs
@@ -229,11 +229,29 @@ foldr1 _ []             =  errorEmptyList "foldr1"
 --
 -- > head (scanr f z xs) == foldr f z xs.
 
+{-# NOINLINE [1] scanr #-}
 scanr                   :: (a -> b -> b) -> b -> [a] -> [b]
 scanr _ q0 []           =  [q0]
 scanr f q0 (x:xs)       =  f x q : qs
                            where qs@(q:_) = scanr f q0 xs
 
+{-# INLINE [0] strictUncurryScanr #-}
+strictUncurryScanr :: (a -> b -> c) -> (a, b) -> c
+strictUncurryScanr f pair = case pair of
+                              (x, y) -> f x y
+
+{-# INLINE [0] scanrFB #-}
+scanrFB :: (a -> b -> b) -> (b -> c -> c) -> a -> (b, c) -> (b, c)
+scanrFB f c = \x (r, est) -> (f x r, r `c` est)
+
+{-# RULES
+"scanr" [~1] forall f q0 ls . scanr f q0 ls =
+  build (\c n -> strictUncurryScanr c (foldr (scanrFB f c) (q0,n) ls))
+"scanrList" [1] forall f q0 ls .
+               strictUncurryScanr (:) (foldr (scanrFB f (:)) (q0,[]) ls) =
+                 scanr f q0 ls
+ #-}
+
 -- | 'scanr1' is a variant of 'scanr' that has no starting value argument.
 
 scanr1                  :: (a -> a -> a) -> [a] -> [a]
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index 7529782..c594c2f 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -77,6 +77,8 @@
     second argument, so that the fusion RULES for it do not change the
     semantics. (#9596)
 
+  * `scanr` now takes part in list fusion (#9355)
+
 ## 4.7.0.1  *Jul 2014*
 
   * Bundled with GHC 7.8.3