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 #include "HsVersions.h"
27 #ifdef __GLASGOW_HASKELL__
30 #elif defined(__YALE_HASKELL__)
31 {-hide import from mkdependHS-}
35 {-hide import from mkdependHS-}
40 #ifdef __GLASGOW_HASKELL__
42 data BitSet = MkBS Word#
45 emptyBS = MkBS (int2Word# 0#)
47 mkBS :: [Int] -> BitSet
48 mkBS xs = foldr (unionBS . unitBS) emptyBS xs
50 unitBS :: Int -> BitSet
52 #if __GLASGOW_HASKELL__ >= 503
53 I# i# -> MkBS ((int2Word# 1#) `uncheckedShiftL#` i#)
55 I# i# -> MkBS ((int2Word# 1#) `shiftL#` i#)
58 unionBS :: BitSet -> BitSet -> BitSet
59 unionBS (MkBS x#) (MkBS y#) = MkBS (x# `or#` y#)
61 minusBS :: BitSet -> BitSet -> BitSet
62 minusBS (MkBS x#) (MkBS y#) = MkBS (x# `and#` (not# y#))
66 isEmptyBS :: BitSet -> Bool
68 = case word2Int# s# of
72 intersectBS :: BitSet -> BitSet -> BitSet
73 intersectBS (MkBS x#) (MkBS y#) = MkBS (x# `and#` y#)
75 elementBS :: Int -> BitSet -> Bool
76 elementBS x (MkBS s#) = case x of
77 I# i# -> case word2Int# (((int2Word# 1#) `shiftL#` i#) `and#` s#) of
82 listBS :: BitSet -> [Int]
83 listBS s = listify s 0
84 where listify (MkBS s#) n =
87 _ -> let s' = (MkBS (s# `shiftr` 1#))
88 more = listify s' (n + 1)
89 in case word2Int# (s# `and#` (int2Word# 1#)) of
92 #if __GLASGOW_HASKELL__ >= 503
93 shiftr x y = uncheckedShiftRL# x y
95 shiftr x y = shiftRL# x y
98 -- intBS is a bit naughty.
99 intBS :: BitSet -> Int
100 intBS (MkBS w#) = I# (word2Int# w#)
102 #elif defined(__YALE_HASKELL__)
104 data BitSet = MkBS Int
109 mkBS :: [Int] -> BitSet
110 mkBS xs = foldr (unionBS . unitBS) emptyBS xs
112 unitBS :: Int -> BitSet
113 unitBS x = MkBS (1 `ashInt` x)
115 unionBS :: BitSet -> BitSet -> BitSet
116 unionBS (MkBS x) (MkBS y) = MkBS (x `logiorInt` y)
120 isEmptyBS :: BitSet -> Bool
126 intersectBS :: BitSet -> BitSet -> BitSet
127 intersectBS (MkBS x) (MkBS y) = MkBS (x `logandInt` y)
129 elementBS :: Int -> BitSet -> Bool
131 = case logbitpInt x s of
136 minusBS :: BitSet -> BitSet -> BitSet
137 minusBS (MkBS x) (MkBS y) = MkBS (x `logandc2Int` y)
139 -- rewritten to avoid right shifts (which would give nonsense on negative
141 listBS :: BitSet -> [Int]
142 listBS (MkBS s) = listify s 0 1
143 where listify s n m =
146 _ -> let n' = n+1; m' = m+m in
147 case logbitpInt s m of
149 _ -> n : listify (s `logandc2Int` m) n' m'
151 #else /* HBC, perhaps? */
153 data BitSet = MkBS Word
158 mkBS :: [Int] -> BitSet
159 mkBS xs = foldr (unionBS . unitBS) emptyBS xs
161 unitBS :: Int -> BitSet
162 unitBS x = MkBS (1 `bitLsh` x)
164 unionBS :: BitSet -> BitSet -> BitSet
165 unionBS (MkBS x) (MkBS y) = MkBS (x `bitOr` y)
169 isEmptyBS :: BitSet -> Bool
175 intersectBS :: BitSet -> BitSet -> BitSet
176 intersectBS (MkBS x) (MkBS y) = MkBS (x `bitAnd` y)
178 elementBS :: Int -> BitSet -> Bool
180 = case (1 `bitLsh` x) `bitAnd` s of
185 minusBS :: BitSet -> BitSet -> BitSet
186 minusBS (MkBS x) (MkBS y) = MkBS (x `bitAnd` (bitCompl y))
188 listBS :: BitSet -> [Int]
189 listBS (MkBS s) = listify s 0
193 _ -> let s' = s `bitRsh` 1
194 more = listify s' (n + 1)
195 in case (s `bitAnd` 1) of