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__
33 #elif defined(__YALE_HASKELL__)
34 {-hide import from mkdependHS-}
38 {-hide import from mkdependHS-}
43 #ifdef __GLASGOW_HASKELL__
45 data BitSet = MkBS Word#
48 emptyBS = MkBS (int2Word# 0#)
50 mkBS :: [Int] -> BitSet
51 mkBS xs = foldr (unionBS . unitBS) emptyBS xs
53 unitBS :: Int -> BitSet
55 I# i# -> MkBS ((int2Word# 1#) `shiftL#` i#)
57 unionBS :: BitSet -> BitSet -> BitSet
58 unionBS (MkBS x#) (MkBS y#) = MkBS (x# `or#` y#)
60 minusBS :: BitSet -> BitSet -> BitSet
61 minusBS (MkBS x#) (MkBS y#) = MkBS (x# `and#` (not# y#))
63 #if ! defined(COMPILING_GHC)
65 isEmptyBS :: BitSet -> Bool
67 = case word2Int# s# of
71 intersectBS :: BitSet -> BitSet -> BitSet
72 intersectBS (MkBS x#) (MkBS y#) = MkBS (x# `and#` y#)
74 elementBS :: Int -> BitSet -> Bool
75 elementBS x (MkBS s#) = case x of
76 I# i# -> case word2Int# (((int2Word# 1#) `shiftL#` i#) `and#` s#) of
81 listBS :: BitSet -> [Int]
82 listBS s = listify s 0
83 where listify (MkBS s#) n =
86 _ -> let s' = (MkBS (s# `shiftr` 1#))
87 more = listify s' (n + 1)
88 in case word2Int# (s# `and#` (int2Word# 1#)) of
91 shiftr x y = shiftRL# x y
93 #elif defined(__YALE_HASKELL__)
95 data BitSet = MkBS Int
100 mkBS :: [Int] -> BitSet
101 mkBS xs = foldr (unionBS . unitBS) emptyBS xs
103 unitBS :: Int -> BitSet
104 unitBS x = MkBS (1 `ashInt` x)
106 unionBS :: BitSet -> BitSet -> BitSet
107 unionBS (MkBS x) (MkBS y) = MkBS (x `logiorInt` y)
109 #if ! defined(COMPILING_GHC)
111 isEmptyBS :: BitSet -> Bool
117 intersectBS :: BitSet -> BitSet -> BitSet
118 intersectBS (MkBS x) (MkBS y) = MkBS (x `logandInt` y)
120 elementBS :: Int -> BitSet -> Bool
122 = case logbitpInt x s of
127 minusBS :: BitSet -> BitSet -> BitSet
128 minusBS (MkBS x) (MkBS y) = MkBS (x `logandc2Int` y)
130 -- rewritten to avoid right shifts (which would give nonsense on negative
132 listBS :: BitSet -> [Int]
133 listBS (MkBS s) = listify s 0 1
134 where listify s n m =
137 _ -> let n' = n+1; m' = m+m in
138 case logbitpInt s m of
140 _ -> n : listify (s `logandc2Int` m) n' m'
142 #else /* HBC, perhaps? */
144 data BitSet = MkBS Word
149 mkBS :: [Int] -> BitSet
150 mkBS xs = foldr (unionBS . unitBS) emptyBS xs
152 unitBS :: Int -> BitSet
153 unitBS x = MkBS (1 `bitLsh` x)
155 unionBS :: BitSet -> BitSet -> BitSet
156 unionBS (MkBS x) (MkBS y) = MkBS (x `bitOr` y)
158 #if ! defined(COMPILING_GHC)
160 isEmptyBS :: BitSet -> Bool
166 intersectBS :: BitSet -> BitSet -> BitSet
167 intersectBS (MkBS x) (MkBS y) = MkBS (x `bitAnd` y)
169 elementBS :: Int -> BitSet -> Bool
171 = case (1 `bitLsh` x) `bitAnd` s of
176 minusBS :: BitSet -> BitSet -> BitSet
177 minusBS (MkBS x) (MkBS y) = MkBS (x `bitAnd` (bitCompl y))
179 listBS :: BitSet -> [Int]
180 listBS (MkBS s) = listify s 0
184 _ -> let s' = s `bitRsh` 1
185 more = listify s' (n + 1)
186 in case (s `bitAnd` 1) of