From d41dd03fdf0ef723ca31f5a11f07a54a15d2cbc0 Mon Sep 17 00:00:00 2001
From: David Feuer <David.Feuer@gmail.com>
Date: Wed, 1 Oct 2014 15:42:27 +0200
Subject: [PATCH] Make mapAccumL a good consumer
This fixes #9502.
---
libraries/base/Data/OldList.hs | 17 +++++++++++++++++
libraries/base/changelog.md | 2 +-
2 files changed, 18 insertions(+), 1 deletion(-)
diff --git a/libraries/base/Data/OldList.hs b/libraries/base/Data/OldList.hs
index fe0f38e284e5..9b6a431422d8 100644
--- a/libraries/base/Data/OldList.hs
+++ b/libraries/base/Data/OldList.hs
@@ -481,11 +481,28 @@ mapAccumL :: (acc -> x -> (acc, y)) -- Function of elt of input list
-> acc -- Initial accumulator
-> [x] -- Input list
-> (acc, [y]) -- Final accumulator and result list
+{-# NOINLINE [1] mapAccumL #-}
mapAccumL _ s [] = (s, [])
mapAccumL f s (x:xs) = (s'',y:ys)
where (s', y ) = f s x
(s'',ys) = mapAccumL f s' xs
+{-# RULES
+"mapAccumL" [~1] forall f s xs . mapAccumL f s xs = foldr (mapAccumLF f) pairWithNil xs s
+"mapAccumLList" [1] forall f s xs . foldr (mapAccumLF f) pairWithNil xs s = mapAccumL f s xs
+ #-}
+
+pairWithNil :: acc -> (acc, [y])
+{-# INLINE [0] pairWithNil #-}
+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
+ (s'', ys) = r s'
+ in (s'', y:ys)
+
+
-- | The 'mapAccumR' function behaves like a combination of 'map' and
-- 'foldr'; it applies a function to each element of a list, passing
-- an accumulating parameter from right to left, and returning a final
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index c594c2fcf407..09b749afd6f2 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -77,7 +77,7 @@
second argument, so that the fusion RULES for it do not change the
semantics. (#9596)
- * `scanr` now takes part in list fusion (#9355)
+ * `scanr` and `mapAccumL` now take part in list fusion (#9355, #9502)
## 4.7.0.1 *Jul 2014*
--
GitLab