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