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