2 % (c) The GRASP Project, Glasgow University, 1994-1995
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,
23 #if ! defined(COMPILING_GHC)
24 , elementBS, intersectBS, isEmptyBS
28 #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 I# i# -> MkBS ((int2Word# 1#) `shiftL#` i#)
54 unionBS :: BitSet -> BitSet -> BitSet
55 unionBS (MkBS x#) (MkBS y#) = MkBS (x# `or#` y#)
57 minusBS :: BitSet -> BitSet -> BitSet
58 minusBS (MkBS x#) (MkBS y#) = MkBS (x# `and#` (not# y#))
60 #if ! defined(COMPILING_GHC)
62 isEmptyBS :: BitSet -> Bool
64 = case word2Int# s# of
68 intersectBS :: BitSet -> BitSet -> BitSet
69 intersectBS (MkBS x#) (MkBS y#) = MkBS (x# `and#` y#)
71 elementBS :: Int -> BitSet -> Bool
72 elementBS x (MkBS s#) = case x of
73 I# i# -> case word2Int# (((int2Word# 1#) `shiftL#` i#) `and#` s#) of
78 listBS :: BitSet -> [Int]
79 listBS s = listify s 0
80 where listify (MkBS s#) n =
83 _ -> let s' = (MkBS (s# `shiftr` 1#))
84 more = listify s' (n + 1)
85 in case word2Int# (s# `and#` (int2Word# 1#)) of
88 shiftr x y = shiftRL# x y
90 #elif defined(__YALE_HASKELL__)
92 data BitSet = MkBS Int
97 mkBS :: [Int] -> BitSet
98 mkBS xs = foldr (unionBS . unitBS) emptyBS xs
100 unitBS :: Int -> BitSet
101 unitBS x = MkBS (1 `ashInt` x)
103 unionBS :: BitSet -> BitSet -> BitSet
104 unionBS (MkBS x) (MkBS y) = MkBS (x `logiorInt` y)
106 #if ! defined(COMPILING_GHC)
108 isEmptyBS :: BitSet -> Bool
114 intersectBS :: BitSet -> BitSet -> BitSet
115 intersectBS (MkBS x) (MkBS y) = MkBS (x `logandInt` y)
117 elementBS :: Int -> BitSet -> Bool
119 = case logbitpInt x s of
124 minusBS :: BitSet -> BitSet -> BitSet
125 minusBS (MkBS x) (MkBS y) = MkBS (x `logandc2Int` y)
127 -- rewritten to avoid right shifts (which would give nonsense on negative
129 listBS :: BitSet -> [Int]
130 listBS (MkBS s) = listify s 0 1
131 where listify s n m =
134 _ -> let n' = n+1; m' = m+m in
135 case logbitpInt s m of
137 _ -> n : listify (s `logandc2Int` m) n' m'
139 #else /* HBC, perhaps? */
141 data BitSet = MkBS Word
146 mkBS :: [Int] -> BitSet
147 mkBS xs = foldr (unionBS . unitBS) emptyBS xs
149 unitBS :: Int -> BitSet
150 unitBS x = MkBS (1 `bitLsh` x)
152 unionBS :: BitSet -> BitSet -> BitSet
153 unionBS (MkBS x) (MkBS y) = MkBS (x `bitOr` y)
155 #if ! defined(COMPILING_GHC)
157 isEmptyBS :: BitSet -> Bool
163 intersectBS :: BitSet -> BitSet -> BitSet
164 intersectBS (MkBS x) (MkBS y) = MkBS (x `bitAnd` y)
166 elementBS :: Int -> BitSet -> Bool
168 = case (1 `bitLsh` x) `bitAnd` s of
173 minusBS :: BitSet -> BitSet -> BitSet
174 minusBS (MkBS x) (MkBS y) = MkBS (x `bitAnd` (bitCompl y))
176 listBS :: BitSet -> [Int]
177 listBS (MkBS s) = listify s 0
181 _ -> let s' = s `bitRsh` 1
182 more = listify s' (n + 1)
183 in case (s `bitAnd` 1) of