X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Futils%2FBitSet.lhs;h=22afea6da23133e4d95a9d84c3f6a69c6b8ef5d8;hb=d157569b69805f1ba1353223f991ba2b036cc0b1;hp=fcd837d2d442d1e33490c4faf93261ed8181de89;hpb=6c381e873e222417d9a67aeec77b9555eca7b7a8;p=ghc-hetmet.git diff --git a/ghc/compiler/utils/BitSet.lhs b/ghc/compiler/utils/BitSet.lhs index fcd837d..22afea6 100644 --- 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