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