2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[Bags]{@Bag@: an unordered collection with duplicates}
8 #include "HsVersions.h"
14 emptyBag, unitBag, unionBags, unionManyBags,
19 filterBag, partitionBag, concatBag, foldBag, foldrBag,
20 isEmptyBag, consBag, snocBag,
26 IMPORT_1_3(List(partition))
28 import Outputable --( interpp'SP )
31 import List(partition)
37 | TwoBags (Bag a) (Bag a) -- The ADT guarantees that at least
38 -- one branch is non-empty
39 | ListBag [a] -- The list is non-empty
40 | ListOfBags [Bag a] -- The list is non-empty
46 elemBag :: Eq a => a -> Bag a -> Bool
48 elemBag x EmptyBag = False
49 elemBag x (UnitBag y) = x==y
50 elemBag x (TwoBags b1 b2) = x `elemBag` b1 || x `elemBag` b2
51 elemBag x (ListBag ys) = any (x ==) ys
52 elemBag x (ListOfBags bs) = any (x `elemBag`) bs
55 unionManyBags [] = EmptyBag
56 unionManyBags xs = ListOfBags xs
58 -- This one is a bit stricter! The bag will get completely evaluated.
60 unionBags EmptyBag b = b
61 unionBags b EmptyBag = b
62 unionBags b1 b2 = TwoBags b1 b2
64 consBag :: a -> Bag a -> Bag a
65 snocBag :: Bag a -> a -> Bag a
67 consBag elt bag = (unitBag elt) `unionBags` bag
68 snocBag bag elt = bag `unionBags` (unitBag elt)
70 isEmptyBag EmptyBag = True
71 isEmptyBag (UnitBag x) = False
72 isEmptyBag (TwoBags b1 b2) = isEmptyBag b1 && isEmptyBag b2 -- Paranoid, but safe
73 isEmptyBag (ListBag xs) = null xs -- Paranoid, but safe
74 isEmptyBag (ListOfBags bs) = all isEmptyBag bs
76 filterBag :: (a -> Bool) -> Bag a -> Bag a
77 filterBag pred EmptyBag = EmptyBag
78 filterBag pred b@(UnitBag val) = if pred val then b else EmptyBag
79 filterBag pred (TwoBags b1 b2) = sat1 `unionBags` sat2
81 sat1 = filterBag pred b1
82 sat2 = filterBag pred b2
83 filterBag pred (ListBag vs) = listToBag (filter pred vs)
84 filterBag pred (ListOfBags bs) = ListOfBags sats
86 sats = [filterBag pred b | b <- bs]
88 concatBag :: Bag (Bag a) -> Bag a
90 concatBag EmptyBag = EmptyBag
91 concatBag (UnitBag b) = b
92 concatBag (TwoBags b1 b2) = concatBag b1 `TwoBags` concatBag b2
93 concatBag (ListBag bs) = ListOfBags bs
94 concatBag (ListOfBags bbs) = ListOfBags (map concatBag bbs)
96 partitionBag :: (a -> Bool) -> Bag a -> (Bag a {- Satisfy predictate -},
98 partitionBag pred EmptyBag = (EmptyBag, EmptyBag)
99 partitionBag pred b@(UnitBag val) = if pred val then (b, EmptyBag) else (EmptyBag, b)
100 partitionBag pred (TwoBags b1 b2) = (sat1 `unionBags` sat2, fail1 `unionBags` fail2)
102 (sat1,fail1) = partitionBag pred b1
103 (sat2,fail2) = partitionBag pred b2
104 partitionBag pred (ListBag vs) = (listToBag sats, listToBag fails)
106 (sats,fails) = partition pred vs
107 partitionBag pred (ListOfBags bs) = (ListOfBags sats, ListOfBags fails)
109 (sats, fails) = unzip [partitionBag pred b | b <- bs]
112 foldBag :: (r -> r -> r) -- Replace TwoBags with this; should be associative
113 -> (a -> r) -- Replace UnitBag with this
114 -> r -- Replace EmptyBag with this
118 {- Standard definition
119 foldBag t u e EmptyBag = e
120 foldBag t u e (UnitBag x) = u x
121 foldBag t u e (TwoBags b1 b2) = (foldBag t u e b1) `t` (foldBag t u e b2)
122 foldBag t u e (ListBag xs) = foldr (t.u) e xs
123 foldBag t u e (ListOfBags bs) = foldr (\b r -> foldBag e u t b `t` r) e bs
126 -- More tail-recursive definition, exploiting associativity of "t"
127 foldBag t u e EmptyBag = e
128 foldBag t u e (UnitBag x) = u x `t` e
129 foldBag t u e (TwoBags b1 b2) = foldBag t u (foldBag t u e b2) b1
130 foldBag t u e (ListBag xs) = foldr (t.u) e xs
131 foldBag t u e (ListOfBags bs) = foldr (\b r -> foldBag t u r b) e bs
133 foldrBag :: (a -> r -> r) -> r
137 foldrBag k z EmptyBag = z
138 foldrBag k z (UnitBag x) = k x z
139 foldrBag k z (TwoBags b1 b2) = foldrBag k (foldrBag k z b2) b1
140 foldrBag k z (ListBag xs) = foldr k z xs
141 foldrBag k z (ListOfBags bs) = foldr (\b r -> foldrBag k r b) z bs
144 mapBag :: (a -> b) -> Bag a -> Bag b
145 mapBag f EmptyBag = EmptyBag
146 mapBag f (UnitBag x) = UnitBag (f x)
147 mapBag f (TwoBags b1 b2) = TwoBags (mapBag f b1) (mapBag f b2)
148 mapBag f (ListBag xs) = ListBag (map f xs)
149 mapBag f (ListOfBags bs) = ListOfBags (map (mapBag f) bs)
152 listToBag :: [a] -> Bag a
153 listToBag [] = EmptyBag
154 listToBag vs = ListBag vs
156 bagToList :: Bag a -> [a]
157 bagToList b = foldrBag (:) [] b
163 instance (Outputable a) => Outputable (Bag a) where
164 ppr sty EmptyBag = ptext SLIT("emptyBag")
165 ppr sty (UnitBag a) = ppr sty a
166 ppr sty (TwoBags b1 b2) = hsep [ppr sty b1 <> comma, ppr sty b2]
167 ppr sty (ListBag as) = interpp'SP sty as
168 ppr sty (ListOfBags bs) = brackets (interpp'SP sty bs)
170 #endif {- COMPILING_GHC -}