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 #if __GLASGOW_HASKELL__ >= 503
  51     I# i# -> MkBS ((int2Word# 1#) `uncheckedShiftL#` i#)
  52 #else
  53     I# i# -> MkBS ((int2Word# 1#) `shiftL#` i#)
  54 #endif
  55
  56 unionBS :: BitSet -> BitSet -> BitSet
  57 unionBS (MkBS x#) (MkBS y#) = MkBS (x# `or#` y#)
  58
  59 minusBS :: BitSet -> BitSet -> BitSet
  60 minusBS (MkBS x#) (MkBS y#) = MkBS (x# `and#` (not# y#))
  61
  62 #if 0
  63 -- not used in GHC
  64 isEmptyBS :: BitSet -> Bool
  65 isEmptyBS (MkBS s#)
  66   = case word2Int# s# of
  67         0# -> True
  68         _  -> False
  69
  70 intersectBS :: BitSet -> BitSet -> BitSet
  71 intersectBS (MkBS x#) (MkBS y#) = MkBS (x# `and#` y#)
  72
  73 elementBS :: Int -> BitSet -> Bool
  74 elementBS x (MkBS s#) = case x of
  75     I# i# -> case word2Int# (((int2Word# 1#) `shiftL#` i#) `and#` s#) of
  76                     0# -> False
  77                     _  -> True
  78 #endif
  79
  80 listBS :: BitSet -> [Int]
  81 listBS s = listify s 0
  82     where listify (MkBS s#) n =
  83             case word2Int# s# of
  84                 0# -> []
  85                 _  -> let s' = (MkBS (s# `shiftr` 1#))
  86                           more = listify s' (n + 1)
  87                       in case word2Int# (s# `and#` (int2Word# 1#)) of
  88                           0# -> more
  89                           _  -> n : more
  90 #if __GLASGOW_HASKELL__ >= 503
  91           shiftr x y = uncheckedShiftRL# x y
  92 #else
  93           shiftr x y = shiftRL# x y
  94 #endif
  95
  96 -- intBS is a bit naughty.
  97 intBS :: BitSet -> Int
  98 intBS (MkBS w#) = I# (word2Int# w#)
  99
 100 #elif defined(__YALE_HASKELL__)
 101
 102 data BitSet = MkBS Int
 103
 104 emptyBS :: BitSet
 105 emptyBS = MkBS 0
 106
 107 mkBS :: [Int] -> BitSet
 108 mkBS xs = foldr (unionBS . unitBS) emptyBS xs
 109
 110 unitBS :: Int -> BitSet
 111 unitBS x = MkBS (1 `ashInt` x)
 112
 113 unionBS :: BitSet -> BitSet -> BitSet
 114 unionBS (MkBS x) (MkBS y) = MkBS (x `logiorInt` y)
 115
 116 #if 0
 117 -- not used in GHC
 118 isEmptyBS :: BitSet -> Bool
 119 isEmptyBS (MkBS s)
 120   = case s of
 121         0 -> True
 122         _ -> False
 123
 124 intersectBS :: BitSet -> BitSet -> BitSet
 125 intersectBS (MkBS x) (MkBS y) = MkBS (x `logandInt` y)
 126
 127 elementBS :: Int -> BitSet -> Bool
 128 elementBS x (MkBS s)
 129   = case logbitpInt x s of
 130         0 -> False
 131         _ -> True
 132 #endif
 133
 134 minusBS :: BitSet -> BitSet -> BitSet
 135 minusBS (MkBS x) (MkBS y) = MkBS (x `logandc2Int` y)
 136
 137 -- rewritten to avoid right shifts (which would give nonsense on negative
 138 -- values.
 139 listBS :: BitSet -> [Int]
 140 listBS (MkBS s) = listify s 0 1
 141     where listify s n m =
 142             case s of
 143                 0 -> []
 144                 _ -> let n' = n+1; m' = m+m in
 145                      case logbitpInt s m of
 146                      0 -> listify s n' m'
 147                      _ -> n : listify (s `logandc2Int` m) n' m'
 148
 149 #else   /* HBC, perhaps? */
 150
 151 data BitSet = MkBS Word
 152
 153 emptyBS :: BitSet
 154 emptyBS = MkBS 0
 155
 156 mkBS :: [Int] -> BitSet
 157 mkBS xs = foldr (unionBS . unitBS) emptyBS xs
 158
 159 unitBS :: Int -> BitSet
 160 unitBS x = MkBS (1 `bitLsh` x)
 161
 162 unionBS :: BitSet -> BitSet -> BitSet
 163 unionBS (MkBS x) (MkBS y) = MkBS (x `bitOr` y)
 164
 165 #if 0
 166 -- not used in GHC
 167 isEmptyBS :: BitSet -> Bool
 168 isEmptyBS (MkBS s)
 169   = case s of
 170         0 -> True
 171         _ -> False
 172
 173 intersectBS :: BitSet -> BitSet -> BitSet
 174 intersectBS (MkBS x) (MkBS y) = MkBS (x `bitAnd` y)
 175
 176 elementBS :: Int -> BitSet -> Bool
 177 elementBS x (MkBS s)
 178   = case (1 `bitLsh` x) `bitAnd` s of
 179         0 -> False
 180         _ -> True
 181 #endif
 182
 183 minusBS :: BitSet -> BitSet -> BitSet
 184 minusBS (MkBS x) (MkBS y) = MkBS (x `bitAnd` (bitCompl y))
 185
 186 listBS :: BitSet -> [Int]
 187 listBS (MkBS s) = listify s 0
 188     where listify s n =
 189             case s of
 190                 0 -> []
 191                 _ -> let s' = s `bitRsh` 1
 192                          more = listify s' (n + 1)
 193                      in case (s `bitAnd` 1) of
 194                             0 -> more
 195                             _ -> n : more
 196
 197 #endif
 198
 199 \end{code}
 200
 201
 202
 203