diff options
author | David Feuer <David.Feuer@gmail.com> | 2014-10-01 15:24:43 +0200 |
---|---|---|
committer | Joachim Breitner <mail@joachim-breitner.de> | 2014-10-01 15:46:14 +0200 |
commit | 7fdedf05b2d267dda6549e71d5a9da23110c3881 (patch) | |
tree | 1ee7790414c082182edb9f0b1bc64f1562d3e993 | |
parent | 914342c1ed282ea2d9bdd54d69a455372557d846 (diff) | |
download | haskell-7fdedf05b2d267dda6549e71d5a9da23110c3881.tar.gz |
Make scanr a good producer and consumerwip/validate-T9355
This fixes #9355.
-rw-r--r-- | libraries/base/GHC/List.lhs | 18 | ||||
-rw-r--r-- | libraries/base/changelog.md | 2 |
2 files changed, 20 insertions, 0 deletions
diff --git a/libraries/base/GHC/List.lhs b/libraries/base/GHC/List.lhs index 8c8e4bb050..51f68abe51 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 7529782492..c594c2fcf4 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 |