[project @ 2000-04-14 12:49:39 by simonmar]

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

diff --git a/ghc/compiler/basicTypes/VarSet.lhs b/ghc/compiler/basicTypes/VarSet.lhs
index 217e3a1..faf1db1 100644 (file)
--- a/ghc/compiler/basicTypes/VarSet.lhs
+++ b/ghc/compiler/basicTypes/VarSet.lhs
@@ -5,24 +5,26 @@
 
 \begin{code}
 module VarSet (
-       VarSet, IdSet, GenIdSet, TyVarSet, GenTyVarSet, IdOrTyVarSet,
+       VarSet, IdSet, TyVarSet, UVarSet,
        emptyVarSet, unitVarSet, mkVarSet,
        extendVarSet,
-       elemVarSet, varSetElems,
+       elemVarSet, varSetElems, subVarSet,
        unionVarSet, unionVarSets,
        intersectVarSet, intersectsVarSet,
-       isEmptyVarSet, delVarSet,
+       isEmptyVarSet, delVarSet, delVarSetByKey,
        minusVarSet, foldVarSet, filterVarSet,
-       lookupVarSet, mapVarSet,
+       lookupVarSet, mapVarSet, sizeVarSet, seqVarSet,
 
        uniqAway
     ) where
 
 #include "HsVersions.h"
 
-import Var             ( Var, Id, GenId, TyVar, GenTyVar, IdOrTyVar, setVarUnique )
-import Unique          ( Uniquable(..), incrUnique )
+import CmdLineOpts     ( opt_PprStyle_Debug )
+import Var             ( Var, Id, TyVar, UVar, setVarUnique )
+import Unique          ( Unique, Uniquable(..), incrUnique, deriveUnique )
 import UniqSet
+import UniqFM          ( delFromUFM_Directly )
 import Outputable
 \end{code}
 
@@ -33,32 +35,34 @@ 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
+type UVarSet      = UniqSet UVar
 
-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
+intersectsVarSet:: VarSet -> VarSet -> Bool    -- True if non-empty intersection
+unionVarSet    :: VarSet -> VarSet -> VarSet
+unionVarSets   :: [VarSet] -> VarSet
+varSetElems    :: VarSet -> [Var]
+unitVarSet     :: Var -> VarSet
+extendVarSet   :: VarSet -> Var -> VarSet
+elemVarSet     :: Var -> VarSet -> Bool
+delVarSet      :: 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
+subVarSet      :: VarSet -> VarSet -> Bool
+
+delVarSetByKey :: VarSet -> Unique -> VarSet
 
 emptyVarSet    = emptyUniqSet
 unitVarSet     = unitUniqSet
@@ -76,16 +80,31 @@ mkVarSet    = mkUniqSet
 foldVarSet     = foldUniqSet
 lookupVarSet   = lookupUniqSet
 mapVarSet      = mapUniqSet
+sizeVarSet     = sizeUniqSet
 filterVarSet   = filterUniqSet
+a `subVarSet` b = isEmptyVarSet (a `minusVarSet` b)
+delVarSetByKey = delFromUFM_Directly   -- Can't be bothered to add this to UniqSet
 \end{code}
 
 \begin{code}
-uniqAway :: VarSet fs ft -> Var fs ft -> Var fs ft
+seqVarSet :: VarSet -> ()
+seqVarSet s = sizeVarSet s `seq` ()
+\end{code}
+
+\begin{code}
+uniqAway :: VarSet -> Var -> Var
 -- Give the Var a new unique, different to any in the VarSet
 uniqAway set var
-  = try 1 (incrUnique (getUnique var))
+  | not (var `elemVarSet` set) = var   -- Nothing to do
+
+  | otherwise
+  = try 1 (deriveUnique (getUnique var) (hashUniqSet set))
   where
     try n uniq | uniq `elemUniqSet_Directly` set = try ((n+1)::Int) (incrUnique uniq)
-              | otherwise = {- pprTrace "uniqAway:" (ppr n <+> text "tries") -}
-                            setVarUnique var uniq
+#ifdef DEBUG
+              | opt_PprStyle_Debug && n > 3
+              = pprTrace "uniqAway:" (ppr n <+> text "tries" <+> ppr var) 
+                setVarUnique var uniq
+#endif                     
+              | otherwise = setVarUnique var uniq
 \end{code}