[project @ 1998-12-02 13:17:09 by simonm]

[ghc-hetmet.git] / ghc / compiler / utils / BitSet.lhs

diff --git a/ghc/compiler/utils/BitSet.lhs b/ghc/compiler/utils/BitSet.lhs
index fcd837d..22afea6 100644 (file)
--- a/ghc/compiler/utils/BitSet.lhs
+++ b/ghc/compiler/utils/BitSet.lhs
@@ -1,5 +1,5 @@
 %
-% (c) The GRASP Project, Glasgow University, 1994-1995
+% (c) The GRASP Project, Glasgow University, 1994-1998
 %
 \section[BitSet]{An implementation of very small sets}
 
@@ -18,14 +18,12 @@ Integer and get virtually unlimited sets.
 
 module BitSet (
        BitSet,         -- abstract type
-       mkBS, listBS, emptyBS, singletonBS,
-       unionBS, minusBS
-#if ! defined(COMPILING_GHC)
-       , elementBS, intersectBS, isEmptyBS
-#endif
+       mkBS, listBS, emptyBS, unitBS,
+       unionBS, minusBS, intBS
     ) where
 
 #ifdef __GLASGOW_HASKELL__
+import GlaExts
 -- nothing to import
 #elif defined(__YALE_HASKELL__)
 {-hide import from mkdependHS-}
@@ -45,10 +43,10 @@ emptyBS :: BitSet
 emptyBS = MkBS (int2Word# 0#)
 
 mkBS :: [Int] -> BitSet
-mkBS xs = foldr (unionBS . singletonBS) emptyBS xs
+mkBS xs = foldr (unionBS . unitBS) emptyBS xs
 
-singletonBS :: Int -> BitSet
-singletonBS x = case x of
+unitBS :: Int -> BitSet
+unitBS x = case x of
     I# i# -> MkBS ((int2Word# 1#) `shiftL#` i#)
 
 unionBS :: BitSet -> BitSet -> BitSet
@@ -57,11 +55,11 @@ unionBS (MkBS x#) (MkBS y#) = MkBS (x# `or#` y#)
 minusBS :: BitSet -> BitSet -> BitSet
 minusBS (MkBS x#) (MkBS y#) = MkBS (x# `and#` (not# y#))
 
-#if ! defined(COMPILING_GHC)
+#if 0
 -- not used in GHC
 isEmptyBS :: BitSet -> Bool
-isEmptyBS (MkBS s#) =
-    case word2Int# s# of
+isEmptyBS (MkBS s#)
+  = case word2Int# s# of
        0# -> True
        _  -> False
 
@@ -87,6 +85,10 @@ listBS s = listify s 0
                          _  -> n : more
          shiftr x y = shiftRL# x y
 
+-- intBS is a bit naughty.
+intBS :: BitSet -> Int
+intBS (MkBS w#) = I# (word2Int# w#)
+
 #elif defined(__YALE_HASKELL__)
 
 data BitSet = MkBS Int
@@ -95,19 +97,19 @@ emptyBS :: BitSet
 emptyBS = MkBS 0
 
 mkBS :: [Int] -> BitSet
-mkBS xs = foldr (unionBS . singletonBS) emptyBS xs
+mkBS xs = foldr (unionBS . unitBS) emptyBS xs
 
-singletonBS :: Int -> BitSet
-singletonBS x = MkBS (1 `ashInt` x)
+unitBS :: Int -> BitSet
+unitBS x = MkBS (1 `ashInt` x)
 
 unionBS :: BitSet -> BitSet -> BitSet
 unionBS (MkBS x) (MkBS y) = MkBS (x `logiorInt` y)
 
-#if ! defined(COMPILING_GHC)
+#if 0
 -- not used in GHC
 isEmptyBS :: BitSet -> Bool
-isEmptyBS (MkBS s) =
-    case s of
+isEmptyBS (MkBS s)
+  = case s of
        0 -> True
        _ -> False
 
@@ -115,8 +117,8 @@ intersectBS :: BitSet -> BitSet -> BitSet
 intersectBS (MkBS x) (MkBS y) = MkBS (x `logandInt` y)
 
 elementBS :: Int -> BitSet -> Bool
-elementBS x (MkBS s) =
-    case logbitpInt x s of
+elementBS x (MkBS s)
+  = case logbitpInt x s of
        0 -> False
        _ -> True
 #endif
@@ -144,19 +146,19 @@ emptyBS :: BitSet
 emptyBS = MkBS 0
 
 mkBS :: [Int] -> BitSet
-mkBS xs = foldr (unionBS . singletonBS) emptyBS xs
+mkBS xs = foldr (unionBS . unitBS) emptyBS xs
 
-singletonBS :: Int -> BitSet
-singletonBS x = MkBS (1 `bitLsh` x)
+unitBS :: Int -> BitSet
+unitBS x = MkBS (1 `bitLsh` x)
 
 unionBS :: BitSet -> BitSet -> BitSet
 unionBS (MkBS x) (MkBS y) = MkBS (x `bitOr` y)
 
-#if ! defined(COMPILING_GHC)
+#if 0
 -- not used in GHC
 isEmptyBS :: BitSet -> Bool
-isEmptyBS (MkBS s) =
-    case s of
+isEmptyBS (MkBS s)
+  = case s of
        0 -> True
        _ -> False
 
@@ -164,8 +166,8 @@ intersectBS :: BitSet -> BitSet -> BitSet
 intersectBS (MkBS x) (MkBS y) = MkBS (x `bitAnd` y)
 
 elementBS :: Int -> BitSet -> Bool
-elementBS x (MkBS s) =
-    case (1 `bitLsh` x) `bitAnd` s of
+elementBS x (MkBS s)
+  = case (1 `bitLsh` x) `bitAnd` s of
        0 -> False
        _ -> True
 #endif