X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Futils%2FBag.lhs;h=430af9307558294dbddf5f8e0076a44c24943e1c;hb=257af45faa055de63cc349f492fe64618a9e34a2;hp=15678cfbe8c8049f328568966ab0d80eff0f183f;hpb=5eb1c77c795f92ed0f4c8023847e9d4be1a4fd0d;p=ghc-hetmet.git diff --git a/ghc/compiler/utils/Bag.lhs b/ghc/compiler/utils/Bag.lhs index 15678cf..430af93 100644 --- a/ghc/compiler/utils/Bag.lhs +++ b/ghc/compiler/utils/Bag.lhs @@ -16,7 +16,7 @@ module Bag ( #ifndef COMPILING_GHC elemBag, #endif - filterBag, partitionBag, concatBag, foldBag, + filterBag, partitionBag, concatBag, foldBag, foldrBag, isEmptyBag, consBag, snocBag, listToBag, bagToList ) where @@ -25,7 +25,7 @@ module Bag ( IMP_Ubiq(){-uitous-} IMPORT_1_3(List(partition)) -import Outputable ( interpp'SP ) +import Outputable --( interpp'SP ) import Pretty #else import List(partition) @@ -130,6 +130,16 @@ foldBag t u e (TwoBags b1 b2) = foldBag t u (foldBag t u e b2) b1 foldBag t u e (ListBag xs) = foldr (t.u) e xs foldBag t u e (ListOfBags bs) = foldr (\b r -> foldBag t u r b) e bs +foldrBag :: (a -> r -> r) -> r + -> Bag a + -> r + +foldrBag k z EmptyBag = z +foldrBag k z (UnitBag x) = k x z +foldrBag k z (TwoBags b1 b2) = foldrBag k (foldrBag k z b2) b1 +foldrBag k z (ListBag xs) = foldr k z xs +foldrBag k z (ListOfBags bs) = foldr (\b r -> foldrBag k r b) z bs + mapBag :: (a -> b) -> Bag a -> Bag b mapBag f EmptyBag = EmptyBag @@ -144,28 +154,18 @@ listToBag [] = EmptyBag listToBag vs = ListBag vs bagToList :: Bag a -> [a] -bagToList EmptyBag = [] -bagToList (ListBag vs) = vs -bagToList b = bagToList_append b [] - - -- (bagToList_append b xs) flattens b and puts xs on the end. - -- (not exported) -bagToList_append EmptyBag xs = xs -bagToList_append (UnitBag x) xs = x:xs -bagToList_append (TwoBags b1 b2) xs = bagToList_append b1 (bagToList_append b2 xs) -bagToList_append (ListBag xx) xs = xx++xs -bagToList_append (ListOfBags bs) xs = foldr bagToList_append xs bs +bagToList b = foldrBag (:) [] b \end{code} \begin{code} #ifdef COMPILING_GHC instance (Outputable a) => Outputable (Bag a) where - ppr sty EmptyBag = ppStr "emptyBag" + ppr sty EmptyBag = ptext SLIT("emptyBag") ppr sty (UnitBag a) = ppr sty a - ppr sty (TwoBags b1 b2) = ppCat [ppr sty b1, pp'SP, ppr sty b2] + ppr sty (TwoBags b1 b2) = hsep [ppr sty b1 <> comma, ppr sty b2] ppr sty (ListBag as) = interpp'SP sty as - ppr sty (ListOfBags bs) = ppCat [ppLbrack, interpp'SP sty bs, ppRbrack] + ppr sty (ListOfBags bs) = brackets (interpp'SP sty bs) #endif {- COMPILING_GHC -} \end{code}