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