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, unitBS,
  22         unionBS, minusBS
  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 #elif defined(__YALE_HASKELL__)
  89
  90 data BitSet = MkBS Int
  91
  92 emptyBS :: BitSet
  93 emptyBS = MkBS 0
  94
  95 mkBS :: [Int] -> BitSet
  96 mkBS xs = foldr (unionBS . unitBS) emptyBS xs
  97
  98 unitBS :: Int -> BitSet
  99 unitBS x = MkBS (1 `ashInt` x)
 100
 101 unionBS :: BitSet -> BitSet -> BitSet
 102 unionBS (MkBS x) (MkBS y) = MkBS (x `logiorInt` y)
 103
 104 #if 0
 105 -- not used in GHC
 106 isEmptyBS :: BitSet -> Bool
 107 isEmptyBS (MkBS s)
 108   = case s of
 109         0 -> True
 110         _ -> False
 111
 112 intersectBS :: BitSet -> BitSet -> BitSet
 113 intersectBS (MkBS x) (MkBS y) = MkBS (x `logandInt` y)
 114
 115 elementBS :: Int -> BitSet -> Bool
 116 elementBS x (MkBS s)
 117   = case logbitpInt x s of
 118         0 -> False
 119         _ -> True
 120 #endif
 121
 122 minusBS :: BitSet -> BitSet -> BitSet
 123 minusBS (MkBS x) (MkBS y) = MkBS (x `logandc2Int` y)
 124
 125 -- rewritten to avoid right shifts (which would give nonsense on negative
 126 -- values.
 127 listBS :: BitSet -> [Int]
 128 listBS (MkBS s) = listify s 0 1
 129     where listify s n m =
 130             case s of
 131                 0 -> []
 132                 _ -> let n' = n+1; m' = m+m in
 133                      case logbitpInt s m of
 134                      0 -> listify s n' m'
 135                      _ -> n : listify (s `logandc2Int` m) n' m'
 136
 137 #else   /* HBC, perhaps? */
 138
 139 data BitSet = MkBS Word
 140
 141 emptyBS :: BitSet
 142 emptyBS = MkBS 0
 143
 144 mkBS :: [Int] -> BitSet
 145 mkBS xs = foldr (unionBS . unitBS) emptyBS xs
 146
 147 unitBS :: Int -> BitSet
 148 unitBS x = MkBS (1 `bitLsh` x)
 149
 150 unionBS :: BitSet -> BitSet -> BitSet
 151 unionBS (MkBS x) (MkBS y) = MkBS (x `bitOr` y)
 152
 153 #if 0
 154 -- not used in GHC
 155 isEmptyBS :: BitSet -> Bool
 156 isEmptyBS (MkBS s)
 157   = case s of
 158         0 -> True
 159         _ -> False
 160
 161 intersectBS :: BitSet -> BitSet -> BitSet
 162 intersectBS (MkBS x) (MkBS y) = MkBS (x `bitAnd` y)
 163
 164 elementBS :: Int -> BitSet -> Bool
 165 elementBS x (MkBS s)
 166   = case (1 `bitLsh` x) `bitAnd` s of
 167         0 -> False
 168         _ -> True
 169 #endif
 170
 171 minusBS :: BitSet -> BitSet -> BitSet
 172 minusBS (MkBS x) (MkBS y) = MkBS (x `bitAnd` (bitCompl y))
 173
 174 listBS :: BitSet -> [Int]
 175 listBS (MkBS s) = listify s 0
 176     where listify s n =
 177             case s of
 178                 0 -> []
 179                 _ -> let s' = s `bitRsh` 1
 180                          more = listify s' (n + 1)
 181                      in case (s `bitAnd` 1) of
 182                             0 -> more
 183                             _ -> n : more
 184
 185 #endif
 186
 187 \end{code}
 188
 189
 190
 191