diff options
| -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 |