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"
| UnitBag a
| TwoBags (Bag a) (Bag a) -- INVARIANT: neither branch is empty
| ListBag [a] -- INVARIANT: the list is non-empty
+ deriving Typeable
emptyBag :: Bag a
emptyBag = EmptyBag
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
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
instance (Outputable a) => Outputable (Bag a) where
ppr bag = braces (pprWithCommas ppr (bagToList bag))
-INSTANCE_TYPEABLE1(Bag,bagTc,"Bag")
-
instance Data a => Data (Bag a) where
gfoldl k z b = z listToBag `k` bagToList b -- traverse abstract type abstractly
toConstr _ = abstractConstr $ "Bag("++show (typeOf (undefined::a))++")"