[project @ 2000-06-29 13:08:59 by simonmar]
[ghc-hetmet.git] / ghc / compiler / utils / BitSet.lhs
1 %
2 % (c) The GRASP Project, Glasgow University, 1994-1998
3 %
4 \section[BitSet]{An implementation of very small sets}
5
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
11 to kill you.
12
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.
16
17 \begin{code}
18
19 module BitSet (
20         BitSet,         -- abstract type
21         mkBS, listBS, emptyBS, unitBS,
22         unionBS, minusBS, intBS
23     ) where
24
25 #ifdef __GLASGOW_HASKELL__
26 import GlaExts
27 -- nothing to import
28 #elif defined(__YALE_HASKELL__)
29 {-hide import from mkdependHS-}
30 import
31         LogOpPrims
32 #else
33 {-hide import from mkdependHS-}
34 import
35         Word
36 #endif
37
38 #ifdef __GLASGOW_HASKELL__
39
40 data BitSet = MkBS Word#
41
42 emptyBS :: BitSet
43 emptyBS = MkBS (int2Word# 0#)
44
45 mkBS :: [Int] -> BitSet
46 mkBS xs = foldr (unionBS . unitBS) emptyBS xs
47
48 unitBS :: Int -> BitSet
49 unitBS x = case x of
50     I# i# -> MkBS ((int2Word# 1#) `shiftL#` i#)
51
52 unionBS :: BitSet -> BitSet -> BitSet
53 unionBS (MkBS x#) (MkBS y#) = MkBS (x# `or#` y#)
54
55 minusBS :: BitSet -> BitSet -> BitSet
56 minusBS (MkBS x#) (MkBS y#) = MkBS (x# `and#` (not# y#))
57
58 #if 0
59 -- not used in GHC
60 isEmptyBS :: BitSet -> Bool
61 isEmptyBS (MkBS s#)
62   = case word2Int# s# of
63         0# -> True
64         _  -> False
65
66 intersectBS :: BitSet -> BitSet -> BitSet
67 intersectBS (MkBS x#) (MkBS y#) = MkBS (x# `and#` y#)
68
69 elementBS :: Int -> BitSet -> Bool
70 elementBS x (MkBS s#) = case x of
71     I# i# -> case word2Int# (((int2Word# 1#) `shiftL#` i#) `and#` s#) of
72                     0# -> False
73                     _  -> True
74 #endif
75
76 listBS :: BitSet -> [Int]
77 listBS s = listify s 0
78     where listify (MkBS s#) n =
79             case word2Int# s# of
80                 0# -> []
81                 _  -> let s' = (MkBS (s# `shiftr` 1#))
82                           more = listify s' (n + 1)
83                       in case word2Int# (s# `and#` (int2Word# 1#)) of
84                           0# -> more
85                           _  -> n : more
86           shiftr x y = shiftRL# x y
87
88 -- intBS is a bit naughty.
89 intBS :: BitSet -> Int
90 intBS (MkBS w#) = I# (word2Int# w#)
91
92 #elif defined(__YALE_HASKELL__)
93
94 data BitSet = MkBS Int
95
96 emptyBS :: BitSet
97 emptyBS = MkBS 0
98
99 mkBS :: [Int] -> BitSet
100 mkBS xs = foldr (unionBS . unitBS) emptyBS xs
101
102 unitBS :: Int -> BitSet
103 unitBS x = MkBS (1 `ashInt` x)
104
105 unionBS :: BitSet -> BitSet -> BitSet
106 unionBS (MkBS x) (MkBS y) = MkBS (x `logiorInt` y)
107
108 #if 0
109 -- not used in GHC
110 isEmptyBS :: BitSet -> Bool
111 isEmptyBS (MkBS s)
112   = case s of
113         0 -> True
114         _ -> False
115
116 intersectBS :: BitSet -> BitSet -> BitSet
117 intersectBS (MkBS x) (MkBS y) = MkBS (x `logandInt` y)
118
119 elementBS :: Int -> BitSet -> Bool
120 elementBS x (MkBS s)
121   = case logbitpInt x s of
122         0 -> False
123         _ -> True
124 #endif
125
126 minusBS :: BitSet -> BitSet -> BitSet
127 minusBS (MkBS x) (MkBS y) = MkBS (x `logandc2Int` y)
128
129 -- rewritten to avoid right shifts (which would give nonsense on negative
130 -- values.
131 listBS :: BitSet -> [Int]
132 listBS (MkBS s) = listify s 0 1
133     where listify s n m =
134             case s of
135                 0 -> []
136                 _ -> let n' = n+1; m' = m+m in
137                      case logbitpInt s m of
138                      0 -> listify s n' m'
139                      _ -> n : listify (s `logandc2Int` m) n' m'
140
141 #else   /* HBC, perhaps? */
142
143 data BitSet = MkBS Word
144
145 emptyBS :: BitSet
146 emptyBS = MkBS 0
147
148 mkBS :: [Int] -> BitSet
149 mkBS xs = foldr (unionBS . unitBS) emptyBS xs
150
151 unitBS :: Int -> BitSet
152 unitBS x = MkBS (1 `bitLsh` x)
153
154 unionBS :: BitSet -> BitSet -> BitSet
155 unionBS (MkBS x) (MkBS y) = MkBS (x `bitOr` y)
156
157 #if 0
158 -- not used in GHC
159 isEmptyBS :: BitSet -> Bool
160 isEmptyBS (MkBS s)
161   = case s of
162         0 -> True
163         _ -> False
164
165 intersectBS :: BitSet -> BitSet -> BitSet
166 intersectBS (MkBS x) (MkBS y) = MkBS (x `bitAnd` y)
167
168 elementBS :: Int -> BitSet -> Bool
169 elementBS x (MkBS s)
170   = case (1 `bitLsh` x) `bitAnd` s of
171         0 -> False
172         _ -> True
173 #endif
174
175 minusBS :: BitSet -> BitSet -> BitSet
176 minusBS (MkBS x) (MkBS y) = MkBS (x `bitAnd` (bitCompl y))
177
178 listBS :: BitSet -> [Int]
179 listBS (MkBS s) = listify s 0
180     where listify s n =
181             case s of
182                 0 -> []
183                 _ -> let s' = s `bitRsh` 1
184                          more = listify s' (n + 1)
185                      in case (s `bitAnd` 1) of
186                             0 -> more
187                             _ -> n : more
188
189 #endif
190
191 \end{code}
192
193
194
195