[commit: ghc] wip/T11067: Add mapAccumBagL (7788f82)

[git at git.haskell.org]

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

On branch  : wip/T11067
Link       : http://ghc.haskell.org/trac/ghc/changeset/7788f825d17c27009795a5f2862e7d250051b20a/ghc

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

commit 7788f825d17c27009795a5f2862e7d250051b20a
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Fri Nov 27 14:28:12 2015 +0000

    Add mapAccumBagL


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

7788f825d17c27009795a5f2862e7d250051b20a
 compiler/utils/Bag.hs | 16 ++++++++++++++--
 1 file changed, 14 insertions(+), 2 deletions(-)

diff --git a/compiler/utils/Bag.hs b/compiler/utils/Bag.hs
index 09fc00a..2ac05e7 100644
--- a/compiler/utils/Bag.hs
+++ b/compiler/utils/Bag.hs
@@ -20,7 +20,7 @@ module Bag (
         listToBag, bagToList,
         foldrBagM, foldlBagM, mapBagM, mapBagM_,
         flatMapBagM, flatMapBagPairM,
-        mapAndUnzipBagM, mapAccumBagLM
+        mapAndUnzipBagM, mapAccumBagL, mapAccumBagLM
     ) where
 
 import Outputable
@@ -28,7 +28,7 @@ import Util
 
 import MonadUtils
 import Data.Data
-import Data.List ( partition )
+import Data.List ( partition, mapAccumL )
 import qualified Data.Foldable as Foldable
 
 infixr 3 `consBag`
@@ -241,6 +241,18 @@ mapAndUnzipBagM f (ListBag xs)    = do ts <- mapM f xs
                                        let (rs,ss) = unzip ts
                                        return (ListBag rs, ListBag ss)
 
+mapAccumBagL ::(acc -> x -> (acc, y)) -- ^ combining funcction
+            -> acc                    -- ^ initial state
+            -> Bag x                  -- ^ inputs
+            -> (acc, Bag y)           -- ^ final state, outputs
+mapAccumBagL _ s EmptyBag        = (s, EmptyBag)
+mapAccumBagL f s (UnitBag x)     = let (s1, x1) = f s x in (s1, UnitBag x1)
+mapAccumBagL f s (TwoBags b1 b2) = let (s1, b1') = mapAccumBagL f s  b1
+                                       (s2, b2') = mapAccumBagL f s1 b2
+                                   in (s2, TwoBags b1' b2')
+mapAccumBagL f s (ListBag xs)    = let (s', xs') = mapAccumL f s xs
+                                   in (s', ListBag xs')
+
 mapAccumBagLM :: Monad m
             => (acc -> x -> m (acc, y)) -- ^ combining funcction
             -> acc                      -- ^ initial state