[project @ 1998-04-07 16:40:08 by simonpj]

[ghc-hetmet.git] / ghc / compiler / types / TyVar.lhs

diff --git a/ghc/compiler/types/TyVar.lhs b/ghc/compiler/types/TyVar.lhs
index 0ca0d1a..e0d4178 100644 (file)
--- a/ghc/compiler/types/TyVar.lhs
+++ b/ghc/compiler/types/TyVar.lhs
@@ -2,8 +2,10 @@
 module TyVar (
        GenTyVar(..), TyVar, 
 
-       mkTyVar, mkSysTyVar,
-       tyVarKind,              -- TyVar -> Kind
+       mkTyVar, mkSysTyVar, 
+       tyVarKind,              -- TyVar -> Kind
+        tyVarFlexi,             -- GenTyVar flexi -> flexi
+        setTyVarFlexi,
        cloneTyVar, nameTyVar,
 
        openAlphaTyVar,
@@ -16,10 +18,10 @@ module TyVar (
        growTyVarEnvList, isEmptyTyVarEnv, lookupTyVarEnv, delFromTyVarEnv,
 
        GenTyVarSet, TyVarSet,
-       emptyTyVarSet, unitTyVarSet, unionTyVarSets,
+       emptyTyVarSet, unitTyVarSet, unionTyVarSets, addOneToTyVarSet,
        unionManyTyVarSets, intersectTyVarSets, mkTyVarSet,
        tyVarSetToList, elementOfTyVarSet, minusTyVarSet,
-       isEmptyTyVarSet
+       isEmptyTyVarSet, delOneFromTyVarSet
   ) where
 
 #include "HsVersions.h"
@@ -29,13 +31,13 @@ import Kind         ( Kind, mkBoxedTypeKind, mkTypeKind )
 
 -- others
 import UniqSet         -- nearly all of it
-import UniqFM          ( emptyUFM, listToUFM, addToUFM, lookupUFM,
-                         plusUFM, sizeUFM, delFromUFM, UniqFM
+import UniqFM          ( emptyUFM, listToUFM, addToUFM, lookupUFM, delFromUFM,
+                         plusUFM, sizeUFM, delFromUFM, isNullUFM, UniqFM
                        )
 import BasicTypes      ( Unused, unused )
 import Name            ( mkSysLocalName, mkLocalName, Name, NamedThing(..), OccName )
 import SrcLoc          ( noSrcLoc, SrcLoc )
-import Unique          ( mkAlphaTyVarUnique, Unique, Uniquable(..) )
+import Unique          ( initTyVarUnique, incrUnique, Unique, Uniquable(..) )
 import Util            ( zipEqual )
 import Outputable
 \end{code}
@@ -50,6 +52,12 @@ data GenTyVar flexi_slot
                                -- inference, and to contain usages.
 
 type TyVar   = GenTyVar Unused
+
+tyVarFlexi :: GenTyVar flexi -> flexi
+tyVarFlexi (TyVar _ _ _ flex) = flex
+
+setTyVarFlexi :: GenTyVar flexi1 -> flexi2 -> GenTyVar flexi2
+setTyVarFlexi (TyVar u k n _) flex = TyVar u k n flex
 \end{code}
 
 
@@ -87,10 +95,10 @@ Fixed collection of type variables
        -- openAlphaTyVar is prepared to be instantiated
        -- to a boxed or unboxed type variable.  It's used for the 
        -- result type for "error", so that we can have (error Int# "Help")
-openAlphaTyVar = TyVar (mkAlphaTyVarUnique 1) mkTypeKind Nothing unused
+openAlphaTyVar = TyVar initTyVarUnique mkTypeKind Nothing unused
 
 alphaTyVars = [ TyVar u mkBoxedTypeKind Nothing unused
-             | u <- map mkAlphaTyVarUnique [2..] ]
+             | u <- iterate incrUnique initTyVarUnique]
 
 (alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars
 
@@ -105,7 +113,7 @@ type TyVarEnv elt = UniqFM elt
 emptyTyVarEnv   :: TyVarEnv a
 mkTyVarEnv      :: [(GenTyVar flexi, a)] -> TyVarEnv a
 zipTyVarEnv     :: [GenTyVar flexi] -> [a] -> TyVarEnv a
-addToTyVarEnv :: TyVarEnv a -> GenTyVar flexi -> a -> TyVarEnv a
+addToTyVarEnv    :: TyVarEnv a -> GenTyVar flexi -> a -> TyVarEnv a
 growTyVarEnvList :: TyVarEnv a -> [(GenTyVar flexi, a)] -> TyVarEnv a
 isEmptyTyVarEnv         :: TyVarEnv a -> Bool
 lookupTyVarEnv  :: TyVarEnv a -> GenTyVar flexi -> Maybe a
@@ -118,10 +126,10 @@ addToTyVarEnv    = addToUFM
 lookupTyVarEnv   = lookupUFM
 delFromTyVarEnv  = delFromUFM
 plusTyVarEnv     = plusUFM
+isEmptyTyVarEnv  = isNullUFM
 
 zipTyVarEnv tyvars tys     = listToUFM (zipEqual "zipTyVarEnv" tyvars tys)
 growTyVarEnvList env pairs = plusUFM env (listToUFM pairs)
-isEmptyTyVarEnv   env     = sizeUFM env == 0
 \end{code}
 
 Sets
@@ -140,9 +148,13 @@ elementOfTyVarSet :: GenTyVar flexi -> GenTyVarSet flexi -> Bool
 minusTyVarSet    :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
 isEmptyTyVarSet   :: GenTyVarSet flexi -> Bool
 mkTyVarSet       :: [GenTyVar flexi] -> GenTyVarSet flexi
+addOneToTyVarSet  :: GenTyVarSet flexi -> GenTyVar flexi -> GenTyVarSet flexi
+delOneFromTyVarSet :: GenTyVarSet flexi -> GenTyVar flexi -> GenTyVarSet flexi
 
 emptyTyVarSet            = emptyUniqSet
-unitTyVarSet = unitUniqSet
+unitTyVarSet      = unitUniqSet
+addOneToTyVarSet  = addOneToUniqSet
+delOneFromTyVarSet = delOneFromUniqSet
 intersectTyVarSets= intersectUniqSets
 unionTyVarSets           = unionUniqSets
 unionManyTyVarSets= unionManyUniqSets