2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[Bags]{@Bag@: an unordered collection with duplicates}
7 #include "HsVersions.h"
12 emptyBag, unitBag, unionBags, unionManyBags,
13 mapBag, -- UNUSED: elemBag,
14 filterBag, partitionBag, concatBag, foldBag,
15 isEmptyBag, consBag, snocBag,
21 IMPORT_1_3(List(partition))
23 import Outputable ( interpp'SP )
30 | TwoBags (Bag a) (Bag a) -- The ADT guarantees that at least
31 -- one branch is non-empty
32 | ListBag [a] -- The list is non-empty
33 | ListOfBags [Bag a] -- The list is non-empty
39 elemBag :: Eq a => a -> Bag a -> Bool
41 elemBag x EmptyBag = False
42 elemBag x (UnitBag y) = x==y
43 elemBag x (TwoBags b1 b2) = x `elemBag` b1 || x `elemBag` b2
44 elemBag x (ListBag ys) = any (x ==) ys
45 elemBag x (ListOfBags bs) = any (x `elemBag`) bs
48 unionManyBags [] = EmptyBag
49 unionManyBags xs = ListOfBags xs
51 -- This one is a bit stricter! The bag will get completely evaluated.
53 unionBags EmptyBag b = b
54 unionBags b EmptyBag = b
55 unionBags b1 b2 = TwoBags b1 b2
57 consBag :: a -> Bag a -> Bag a
58 consBag elt bag = (unitBag elt) `unionBags` bag
59 snocBag :: Bag a -> a -> Bag a
60 snocBag bag elt = bag `unionBags` (unitBag elt)
62 isEmptyBag EmptyBag = True
63 isEmptyBag (UnitBag x) = False
64 isEmptyBag (TwoBags b1 b2) = isEmptyBag b1 && isEmptyBag b2 -- Paranoid, but safe
65 isEmptyBag (ListBag xs) = null xs -- Paranoid, but safe
66 isEmptyBag (ListOfBags bs) = all isEmptyBag bs
68 filterBag :: (a -> Bool) -> Bag a -> Bag a
69 filterBag pred EmptyBag = EmptyBag
70 filterBag pred b@(UnitBag val) = if pred val then b else EmptyBag
71 filterBag pred (TwoBags b1 b2) = sat1 `unionBags` sat2
73 sat1 = filterBag pred b1
74 sat2 = filterBag pred b2
75 filterBag pred (ListBag vs) = listToBag (filter pred vs)
76 filterBag pred (ListOfBags bs) = ListOfBags sats
78 sats = [filterBag pred b | b <- bs]
80 concatBag :: Bag (Bag a) -> Bag a
82 concatBag EmptyBag = EmptyBag
83 concatBag (UnitBag b) = b
84 concatBag (TwoBags b1 b2) = concatBag b1 `TwoBags` concatBag b2
85 concatBag (ListBag bs) = ListOfBags bs
86 concatBag (ListOfBags bbs) = ListOfBags (map concatBag bbs)
88 partitionBag :: (a -> Bool) -> Bag a -> (Bag a {- Satisfy predictate -},
90 partitionBag pred EmptyBag = (EmptyBag, EmptyBag)
91 partitionBag pred b@(UnitBag val) = if pred val then (b, EmptyBag) else (EmptyBag, b)
92 partitionBag pred (TwoBags b1 b2) = (sat1 `unionBags` sat2, fail1 `unionBags` fail2)
94 (sat1,fail1) = partitionBag pred b1
95 (sat2,fail2) = partitionBag pred b2
96 partitionBag pred (ListBag vs) = (listToBag sats, listToBag fails)
98 (sats,fails) = partition pred vs
99 partitionBag pred (ListOfBags bs) = (ListOfBags sats, ListOfBags fails)
101 (sats, fails) = unzip [partitionBag pred b | b <- bs]
104 foldBag :: (r -> r -> r) -- Replace TwoBags with this; should be associative
105 -> (a -> r) -- Replace UnitBag with this
106 -> r -- Replace EmptyBag with this
110 {- Standard definition
111 foldBag t u e EmptyBag = e
112 foldBag t u e (UnitBag x) = u x
113 foldBag t u e (TwoBags b1 b2) = (foldBag t u e b1) `t` (foldBag t u e b2)
114 foldBag t u e (ListBag xs) = foldr (t.u) e xs
115 foldBag t u e (ListOfBags bs) = foldr (\b r -> foldBag e u t b `t` r) e bs
118 -- More tail-recursive definition, exploiting associativity of "t"
119 foldBag t u e EmptyBag = e
120 foldBag t u e (UnitBag x) = u x `t` e
121 foldBag t u e (TwoBags b1 b2) = foldBag t u (foldBag t u e b2) b1
122 foldBag t u e (ListBag xs) = foldr (t.u) e xs
123 foldBag t u e (ListOfBags bs) = foldr (\b r -> foldBag t u r b) e bs
126 mapBag :: (a -> b) -> Bag a -> Bag b
127 mapBag f EmptyBag = EmptyBag
128 mapBag f (UnitBag x) = UnitBag (f x)
129 mapBag f (TwoBags b1 b2) = TwoBags (mapBag f b1) (mapBag f b2)
130 mapBag f (ListBag xs) = ListBag (map f xs)
131 mapBag f (ListOfBags bs) = ListOfBags (map (mapBag f) bs)
134 listToBag :: [a] -> Bag a
135 listToBag [] = EmptyBag
136 listToBag vs = ListBag vs
138 bagToList :: Bag a -> [a]
139 bagToList EmptyBag = []
140 bagToList (ListBag vs) = vs
141 bagToList b = bagToList_append b []
143 -- (bagToList_append b xs) flattens b and puts xs on the end.
145 bagToList_append EmptyBag xs = xs
146 bagToList_append (UnitBag x) xs = x:xs
147 bagToList_append (TwoBags b1 b2) xs = bagToList_append b1 (bagToList_append b2 xs)
148 bagToList_append (ListBag xx) xs = xx++xs
149 bagToList_append (ListOfBags bs) xs = foldr bagToList_append xs bs
155 instance (Outputable a) => Outputable (Bag a) where
156 ppr sty EmptyBag = ppStr "emptyBag"
157 ppr sty (UnitBag a) = ppr sty a
158 ppr sty (TwoBags b1 b2) = ppCat [ppr sty b1, pp'SP, ppr sty b2]
159 ppr sty (ListBag as) = interpp'SP sty as
160 ppr sty (ListOfBags bs) = ppCat [ppLbrack, interpp'SP sty bs, ppRbrack]
162 #endif {- COMPILING_GHC -}