Add mapOccEnv

[ghc-hetmet.git] / ghc / compiler / basicTypes / VarSet.lhs

diff --git a/ghc/compiler/basicTypes/VarSet.lhs b/ghc/compiler/basicTypes/VarSet.lhs
index 217e3a1..55e82a8 100644 (file)
--- a/ghc/compiler/basicTypes/VarSet.lhs
+++ b/ghc/compiler/basicTypes/VarSet.lhs
@@ -5,25 +5,24 @@
 
 \begin{code}
 module VarSet (
-       VarSet, IdSet, GenIdSet, TyVarSet, GenTyVarSet, IdOrTyVarSet,
+       VarSet, IdSet, TyVarSet,
        emptyVarSet, unitVarSet, mkVarSet,
-       extendVarSet,
-       elemVarSet, varSetElems,
+       extendVarSet, extendVarSetList, extendVarSet_C,
+       elemVarSet, varSetElems, subVarSet,
        unionVarSet, unionVarSets,
        intersectVarSet, intersectsVarSet,
-       isEmptyVarSet, delVarSet,
+       isEmptyVarSet, delVarSet, delVarSetList, delVarSetByKey,
        minusVarSet, foldVarSet, filterVarSet,
-       lookupVarSet, mapVarSet,
-
-       uniqAway
+       lookupVarSet, mapVarSet, sizeVarSet, seqVarSet,
+       elemVarSetByKey
     ) where
 
 #include "HsVersions.h"
 
-import Var             ( Var, Id, GenId, TyVar, GenTyVar, IdOrTyVar, setVarUnique )
-import Unique          ( Uniquable(..), incrUnique )
+import Var             ( Var, Id, TyVar )
+import Unique          ( Unique )
 import UniqSet
-import Outputable
+import UniqFM          ( delFromUFM_Directly, addToUFM_C )
 \end{code}
 
 %************************************************************************
@@ -33,59 +32,74 @@ import Outputable
 %************************************************************************
 
 \begin{code}
-type VarSet fs ft      = UniqSet (Var fs ft)
-type IdSet            = UniqSet Id
-type GenIdSet flexi    = UniqSet (GenId flexi)
-type TyVarSet         = UniqSet TyVar
-type GenTyVarSet flexi = UniqSet (GenTyVar flexi)
-type IdOrTyVarSet      = UniqSet IdOrTyVar
+type VarSet       = UniqSet Var
+type IdSet       = UniqSet Id
+type TyVarSet    = UniqSet TyVar
 
-emptyVarSet    :: VarSet fs ft
-intersectVarSet        :: VarSet fs ft -> VarSet fs ft -> VarSet fs ft
-intersectsVarSet:: VarSet fs ft -> VarSet fs ft -> Bool        -- True if non-empty intersection
-unionVarSet    :: VarSet fs ft -> VarSet fs ft -> VarSet fs ft
-unionVarSets   :: [VarSet fs ft] -> VarSet fs ft
-varSetElems    :: VarSet fs ft -> [Var fs ft]
-unitVarSet     :: Var fs ft -> VarSet fs ft
-extendVarSet   :: VarSet fs ft -> Var fs ft -> VarSet fs ft
-elemVarSet     :: Var fs ft -> VarSet fs ft -> Bool
-delVarSet      :: VarSet fs ft -> Var fs ft -> VarSet fs ft
-minusVarSet    :: VarSet fs ft -> VarSet fs ft -> VarSet fs ft
-isEmptyVarSet  :: VarSet fs ft -> Bool
-mkVarSet       :: [Var fs ft] -> VarSet fs ft
-foldVarSet     :: (Var fs ft -> a -> a) -> a -> VarSet fs ft -> a
-lookupVarSet   :: VarSet fs ft -> Var fs ft -> Maybe (Var fs ft)
+emptyVarSet    :: VarSet
+intersectVarSet        :: VarSet -> VarSet -> VarSet
+unionVarSet    :: VarSet -> VarSet -> VarSet
+unionVarSets   :: [VarSet] -> VarSet
+varSetElems    :: VarSet -> [Var]
+unitVarSet     :: Var -> VarSet
+extendVarSet   :: VarSet -> Var -> VarSet
+extendVarSetList:: VarSet -> [Var] -> VarSet
+elemVarSet     :: Var -> VarSet -> Bool
+delVarSet      :: VarSet -> Var -> VarSet
+delVarSetList  :: VarSet -> [Var] -> VarSet
+minusVarSet    :: VarSet -> VarSet -> VarSet
+isEmptyVarSet  :: VarSet -> Bool
+mkVarSet       :: [Var] -> VarSet
+foldVarSet     :: (Var -> a -> a) -> a -> VarSet -> a
+lookupVarSet   :: VarSet -> Var -> Maybe Var
                        -- Returns the set element, which may be
                        -- (==) to the argument, but not the same as
-mapVarSet      :: (Var fs ft -> Var fs ft) -> VarSet fs ft -> VarSet fs ft
-filterVarSet   :: (Var fs ft -> Bool) -> VarSet fs ft -> VarSet fs ft
+mapVarSet      :: (Var -> Var) -> VarSet -> VarSet
+sizeVarSet     :: VarSet -> Int
+filterVarSet   :: (Var -> Bool) -> VarSet -> VarSet
+extendVarSet_C  :: (Var->Var->Var) -> VarSet -> Var -> VarSet
+
+delVarSetByKey :: VarSet -> Unique -> VarSet
+elemVarSetByKey :: Unique -> VarSet -> Bool
 
 emptyVarSet    = emptyUniqSet
 unitVarSet     = unitUniqSet
 extendVarSet   = addOneToUniqSet
+extendVarSetList= addListToUniqSet
 intersectVarSet        = intersectUniqSets
-intersectsVarSet s1 s2 = not (isEmptyVarSet (s1 `intersectVarSet` s2))
+
+intersectsVarSet:: VarSet -> VarSet -> Bool    -- True if non-empty intersection
+       -- (s1 `intersectsVarSet` s2) doesn't compute s2 if s1 is empty
+subVarSet      :: VarSet -> VarSet -> Bool     -- True if first arg is subset of second
+       -- (s1 `subVarSet` s2) doesn't compute s2 if s1 is empty
+
 unionVarSet    = unionUniqSets
 unionVarSets   = unionManyUniqSets
 varSetElems    = uniqSetToList
 elemVarSet     = elementOfUniqSet
 minusVarSet    = minusUniqSet
 delVarSet      = delOneFromUniqSet
+delVarSetList  = delListFromUniqSet
 isEmptyVarSet  = isEmptyUniqSet
 mkVarSet       = mkUniqSet
 foldVarSet     = foldUniqSet
 lookupVarSet   = lookupUniqSet
 mapVarSet      = mapUniqSet
+sizeVarSet     = sizeUniqSet
 filterVarSet   = filterUniqSet
+extendVarSet_C combine s x = addToUFM_C combine s x x
+delVarSetByKey = delFromUFM_Directly   -- Can't be bothered to add this to UniqSet
+elemVarSetByKey        = elemUniqSet_Directly
 \end{code}
 
 \begin{code}
-uniqAway :: VarSet fs ft -> Var fs ft -> Var fs ft
--- Give the Var a new unique, different to any in the VarSet
-uniqAway set var
-  = try 1 (incrUnique (getUnique var))
-  where
-    try n uniq | uniq `elemUniqSet_Directly` set = try ((n+1)::Int) (incrUnique uniq)
-              | otherwise = {- pprTrace "uniqAway:" (ppr n <+> text "tries") -}
-                            setVarUnique var uniq
+-- See comments with type signatures
+intersectsVarSet s1 s2 = not (isEmptyVarSet (s1 `intersectVarSet` s2))
+a `subVarSet` b = isEmptyVarSet (a `minusVarSet` b)
 \end{code}
+
+\begin{code}
+seqVarSet :: VarSet -> ()
+seqVarSet s = sizeVarSet s `seq` ()
+\end{code}
+