2 % (c) The GRASP Project, Glasgow University, 1994-1998
4 \section[BitSet]{An implementation of very small sets}
6 Bit sets are a fast implementation of sets of integers ranging from 0
7 to one less than the number of bits in a machine word (typically 31).
8 If any element exceeds the maximum value for a particular machine
9 architecture, the results of these operations are undefined. You have
10 been warned. If you put any safety checks in this code, I will have
13 Note: the Yale Haskell implementation won't provide a full 32 bits.
14 However, if you can handle the performance loss, you could change to
15 Integer and get virtually unlimited sets.
20 BitSet, -- abstract type
21 mkBS, listBS, emptyBS, unitBS,
22 unionBS, minusBS, intBS
25 #ifdef __GLASGOW_HASKELL__
28 #elif defined(__YALE_HASKELL__)
29 {-hide import from mkdependHS-}
33 {-hide import from mkdependHS-}
38 #ifdef __GLASGOW_HASKELL__
40 data BitSet = MkBS Word#
43 emptyBS = MkBS (int2Word# 0#)
45 mkBS :: [Int] -> BitSet
46 mkBS xs = foldr (unionBS . unitBS) emptyBS xs
48 unitBS :: Int -> BitSet
50 #if __GLASGOW_HASKELL__ >= 503
51 I# i# -> MkBS ((int2Word# 1#) `uncheckedShiftL#` i#)
53 I# i# -> MkBS ((int2Word# 1#) `shiftL#` i#)
56 unionBS :: BitSet -> BitSet -> BitSet
57 unionBS (MkBS x#) (MkBS y#) = MkBS (x# `or#` y#)
59 minusBS :: BitSet -> BitSet -> BitSet
60 minusBS (MkBS x#) (MkBS y#) = MkBS (x# `and#` (not# y#))
64 isEmptyBS :: BitSet -> Bool
66 = case word2Int# s# of
70 intersectBS :: BitSet -> BitSet -> BitSet
71 intersectBS (MkBS x#) (MkBS y#) = MkBS (x# `and#` y#)
73 elementBS :: Int -> BitSet -> Bool
74 elementBS x (MkBS s#) = case x of
75 I# i# -> case word2Int# (((int2Word# 1#) `shiftL#` i#) `and#` s#) of
80 listBS :: BitSet -> [Int]
81 listBS s = listify s 0
82 where listify (MkBS s#) n =
85 _ -> let s' = (MkBS (s# `shiftr` 1#))
86 more = listify s' (n + 1)
87 in case word2Int# (s# `and#` (int2Word# 1#)) of
90 #if __GLASGOW_HASKELL__ >= 503
91 shiftr x y = uncheckedShiftRL# x y
93 shiftr x y = shiftRL# x y
96 -- intBS is a bit naughty.
97 intBS :: BitSet -> Int
98 intBS (MkBS w#) = I# (word2Int# w#)
100 #elif defined(__YALE_HASKELL__)
102 data BitSet = MkBS Int
107 mkBS :: [Int] -> BitSet
108 mkBS xs = foldr (unionBS . unitBS) emptyBS xs
110 unitBS :: Int -> BitSet
111 unitBS x = MkBS (1 `ashInt` x)
113 unionBS :: BitSet -> BitSet -> BitSet
114 unionBS (MkBS x) (MkBS y) = MkBS (x `logiorInt` y)
118 isEmptyBS :: BitSet -> Bool
124 intersectBS :: BitSet -> BitSet -> BitSet
125 intersectBS (MkBS x) (MkBS y) = MkBS (x `logandInt` y)
127 elementBS :: Int -> BitSet -> Bool
129 = case logbitpInt x s of
134 minusBS :: BitSet -> BitSet -> BitSet
135 minusBS (MkBS x) (MkBS y) = MkBS (x `logandc2Int` y)
137 -- rewritten to avoid right shifts (which would give nonsense on negative
139 listBS :: BitSet -> [Int]
140 listBS (MkBS s) = listify s 0 1
141 where listify s n m =
144 _ -> let n' = n+1; m' = m+m in
145 case logbitpInt s m of
147 _ -> n : listify (s `logandc2Int` m) n' m'
149 #else /* HBC, perhaps? */
151 data BitSet = MkBS Word
156 mkBS :: [Int] -> BitSet
157 mkBS xs = foldr (unionBS . unitBS) emptyBS xs
159 unitBS :: Int -> BitSet
160 unitBS x = MkBS (1 `bitLsh` x)
162 unionBS :: BitSet -> BitSet -> BitSet
163 unionBS (MkBS x) (MkBS y) = MkBS (x `bitOr` y)
167 isEmptyBS :: BitSet -> Bool
173 intersectBS :: BitSet -> BitSet -> BitSet
174 intersectBS (MkBS x) (MkBS y) = MkBS (x `bitAnd` y)
176 elementBS :: Int -> BitSet -> Bool
178 = case (1 `bitLsh` x) `bitAnd` s of
183 minusBS :: BitSet -> BitSet -> BitSet
184 minusBS (MkBS x) (MkBS y) = MkBS (x `bitAnd` (bitCompl y))
186 listBS :: BitSet -> [Int]
187 listBS (MkBS s) = listify s 0
191 _ -> let s' = s `bitRsh` 1
192 more = listify s' (n + 1)
193 in case (s `bitAnd` 1) of