X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FBag.lhs;h=097a112359601d5814d9dd6bf1658081d90c386d;hb=679a7c41949c438c0a6ace92b0334bb795690738;hp=fa18219cb8d4b3194232f9e8e6d05bed3242eff0;hpb=d2ce0f52d42edf32bb9f13796e6ba6edba8bd516;p=ghc-hetmet.git

diff --git a/compiler/utils/Bag.lhs b/compiler/utils/Bag.lhs
index fa18219..097a112 100644
--- a/compiler/utils/Bag.lhs
+++ b/compiler/utils/Bag.lhs
@@ -16,9 +16,9 @@ module Bag (
         concatBag, foldBag, foldrBag, foldlBag,
         isEmptyBag, isSingletonBag, consBag, snocBag, anyBag,
         listToBag, bagToList,
-        foldlBagM, mapBagM, mapBagM_, 
+        foldrBagM, foldlBagM, mapBagM, mapBagM_, 
         flatMapBagM, flatMapBagPairM,
-        mapAndUnzipBagM
+        mapAndUnzipBagM, mapAccumBagLM
     ) where
 
 #include "Typeable.h"
@@ -171,6 +171,12 @@ foldlBag k z (UnitBag x)     = k z x
 foldlBag k z (TwoBags b1 b2) = foldlBag k (foldlBag k z b1) b2
 foldlBag k z (ListBag xs)    = foldl k z xs
 
+foldrBagM :: (Monad m) => (a -> b -> m b) -> b -> Bag a -> m b
+foldrBagM _ z EmptyBag        = return z
+foldrBagM k z (UnitBag x)     = k x z
+foldrBagM k z (TwoBags b1 b2) = do { z' <- foldrBagM k z b2; foldrBagM k z' b1 }
+foldrBagM k z (ListBag xs)    = foldrM k z xs
+
 foldlBagM :: (Monad m) => (b -> a -> m b) -> b -> Bag a -> m b
 foldlBagM _ z EmptyBag        = return z
 foldlBagM k z (UnitBag x)     = k z x
@@ -231,6 +237,19 @@ mapAndUnzipBagM f (ListBag xs)    = do ts <- mapM f xs
                                        let (rs,ss) = unzip ts
                                        return (ListBag rs, ListBag ss)
 
+mapAccumBagLM :: Monad m
+            => (acc -> x -> m (acc, y)) -- ^ combining funcction
+            -> acc                      -- ^ initial state
+            -> Bag x                    -- ^ inputs
+            -> m (acc, Bag y)           -- ^ final state, outputs
+mapAccumBagLM _ s EmptyBag        = return (s, EmptyBag)
+mapAccumBagLM f s (UnitBag x)     = do { (s1, x1) <- f s x; return (s1, UnitBag x1) }
+mapAccumBagLM f s (TwoBags b1 b2) = do { (s1, b1') <- mapAccumBagLM f s  b1
+                                       ; (s2, b2') <- mapAccumBagLM f s1 b2
+                                       ; return (s2, TwoBags b1' b2') }
+mapAccumBagLM f s (ListBag xs)    = do { (s', xs') <- mapAccumLM f s xs
+                                       ; return (s', ListBag xs') }
+
 listToBag :: [a] -> Bag a
 listToBag [] = EmptyBag
 listToBag vs = ListBag vs