[project @ 2005-01-31 13:22:57 by simonpj]

Rename mkTvSubst to mkOpenTvSubst; add new mkTvSubst

diff --git a/ghc/compiler/typecheck/TcBinds.lhs b/ghc/compiler/typecheck/TcBinds.lhs
index 395744d..509bce7 100644 (file)
--- a/ghc/compiler/typecheck/TcBinds.lhs
+++ b/ghc/compiler/typecheck/TcBinds.lhs
@@ -34,7 +34,7 @@ import TcSimplify     ( bindInstsOfLocalFuns )
 import TcMType         ( newTyFlexiVarTy, tcSkolType, zonkQuantifiedTyVar, zonkTcTypes )
 import TcType          ( TcTyVar, SkolemInfo(SigSkol), 
                          TcTauType, TcSigmaType, 
-                         TvSubstEnv, mkTvSubst, substTheta, substTy, 
+                         TvSubstEnv, mkOpenTvSubst, substTheta, substTy, 
                          mkTyVarTy, mkForAllTys, mkFunTys, tyVarsOfType, 
                          mkForAllTy, isUnLiftedType, tcGetTyVar_maybe, 
                          mkTyVarTys )
@@ -605,7 +605,7 @@ checkSigCtxt sig1 sig@(TcSigInfo { sig_tvs = tvs, sig_theta = theta, sig_tau = t
        Just tvs' -> 
 
     let 
-       subst  = mkTvSubst tenv
+       subst  = mkOpenTvSubst tenv
     in
     return (sig { sig_tvs   = tvs', 
                  sig_theta = substTheta subst theta, 

diff --git a/ghc/compiler/typecheck/TcDeriv.lhs b/ghc/compiler/typecheck/TcDeriv.lhs
index 7ed64c1..45bca4c 100644 (file)
--- a/ghc/compiler/typecheck/TcDeriv.lhs
+++ b/ghc/compiler/typecheck/TcDeriv.lhs
@@ -29,7 +29,7 @@ import RnEnv          ( bindLocalNames )
 import HscTypes                ( DFunId, FixityEnv )
 
 import Class           ( className, classArity, classKey, classTyVars, classSCTheta, Class )
-import Type            ( zipTvSubst, substTheta )
+import Type            ( zipOpenTvSubst, substTheta )
 import ErrUtils                ( dumpIfSet_dyn )
 import MkId            ( mkDictFunId )
 import DataCon         ( isNullarySrcDataCon, isVanillaDataCon, dataConOrigArgTys )
@@ -441,7 +441,7 @@ makeDerivEqns tycl_decls
                -- There's no 'corece' needed because after the type checker newtypes
                -- are transparent.
 
-       sc_theta = substTheta (zipTvSubst clas_tyvars inst_tys)
+       sc_theta = substTheta (zipOpenTvSubst clas_tyvars inst_tys)
                              (classSCTheta clas)
 
                -- If there are no tyvars, there's no need

diff --git a/ghc/compiler/typecheck/TcInstDcls.lhs b/ghc/compiler/typecheck/TcInstDcls.lhs
index 929797a..ff97a4b 100644 (file)
--- a/ghc/compiler/typecheck/TcInstDcls.lhs
+++ b/ghc/compiler/typecheck/TcInstDcls.lhs
@@ -27,7 +27,7 @@ import TcEnv          ( tcExtendGlobalValEnv, tcExtendTyVarEnv,
 import TcHsType                ( kcHsSigType, tcHsKindedType )
 import TcUnify         ( checkSigTyVars )
 import TcSimplify      ( tcSimplifyCheck, tcSimplifyTop )
-import Type            ( zipTvSubst, substTheta, substTys )
+import Type            ( zipOpenTvSubst, substTheta, substTys )
 import DataCon         ( classDataCon )
 import Class           ( classBigSig )
 import Var             ( Id, idName, idType )
@@ -328,7 +328,7 @@ tcInstDecl2 (InstInfo { iDFunId = dfun_id, iBinds = binds })
         (class_tyvars, sc_theta, _, op_items) = classBigSig clas
 
         -- Instantiate the super-class context with inst_tys
-       sc_theta' = substTheta (zipTvSubst class_tyvars inst_tys') sc_theta
+       sc_theta' = substTheta (zipOpenTvSubst class_tyvars inst_tys') sc_theta
        origin    = SigOrigin rigid_info
     in
         -- Create dictionary Ids from the specified instance contexts.
@@ -512,7 +512,7 @@ tcMethods origin clas inst_tyvars' dfun_theta' inst_tys'
        -- of the type variables in the instance declaration; but rep_tys doesn't
        -- have the skolemised version, so we substitute them in here
     rep_tys' = substTys subst rep_tys
-    subst    = zipTvSubst inst_tyvars' (mkTyVarTys inst_tyvars')
+    subst    = zipOpenTvSubst inst_tyvars' (mkTyVarTys inst_tyvars')
 \end{code}
 
 Note: [Superclass loops]

diff --git a/ghc/compiler/typecheck/TcPat.lhs b/ghc/compiler/typecheck/TcPat.lhs
index 64b5abb..9261ecb 100644 (file)
--- a/ghc/compiler/typecheck/TcPat.lhs
+++ b/ghc/compiler/typecheck/TcPat.lhs
@@ -26,7 +26,7 @@ import TcEnv          ( newLocalName, tcExtendIdEnv1, tcExtendTyVarEnv2,
 import TcMType                 ( newTyFlexiVarTy, arityErr, tcSkolTyVars, readMetaTyVar )
 import TcType          ( TcType, TcTyVar, TcSigmaType, TcTauType, zipTopTvSubst,
                          SkolemInfo(PatSkol), isSkolemTyVar, isMetaTyVar, pprSkolemTyVar, 
-                         TvSubst, mkTvSubst, substTyVar, substTy, MetaDetails(..),
+                         TvSubst, mkOpenTvSubst, substTyVar, substTy, MetaDetails(..),
                          mkTyVarTys, mkClassPred, mkTyConApp, isOverloadedTy )
 import VarEnv          ( mkVarEnv )    -- ugly
 import Kind            ( argTypeKind, liftedTypeKind )
@@ -535,7 +535,7 @@ refineTyVars :: [TcTyVar]   -- Newly instantiated meta-tyvars of the function
 -- Just one level of de-wobblification though.  What a hack! 
 refineTyVars tvs
   = do { mb_prs <- mapM mk_pr tvs
-       ; return (mkTvSubst (mkVarEnv (catMaybes mb_prs))) }
+       ; return (mkOpenTvSubst (mkVarEnv (catMaybes mb_prs))) }
   where
     mk_pr tv = do { details <- readMetaTyVar tv
                  ; case details of

diff --git a/ghc/compiler/typecheck/TcType.lhs b/ghc/compiler/typecheck/TcType.lhs
index 39035dd..1c330cb 100644 (file)
--- a/ghc/compiler/typecheck/TcType.lhs
+++ b/ghc/compiler/typecheck/TcType.lhs
@@ -94,7 +94,7 @@ module TcType (
   -- Type substitutions
   TvSubst(..),         -- Representation visible to a few friends
   TvSubstEnv, emptyTvSubst,
-  mkTvSubst, zipTvSubst, zipTopTvSubst, mkTopTvSubst,
+  mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst,
   getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope,
   extendTvSubst, extendTvSubstList, isInScope,
   substTy, substTys, substTyWith, substTheta, substTyVar, substTyVarBndr,
@@ -146,7 +146,7 @@ import Type         (       -- Re-exports
 
                          TvSubst(..),
                          TvSubstEnv, emptyTvSubst,
-                         mkTvSubst, zipTvSubst, zipTopTvSubst, mkTopTvSubst,
+                         mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst,
                          getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope,
                          extendTvSubst, extendTvSubstList, isInScope,
                          substTy, substTys, substTyWith, substTheta, substTyVar, substTyVarBndr,

diff --git a/ghc/compiler/types/Type.lhs b/ghc/compiler/types/Type.lhs
index 6381998..fe848d6 100644 (file)
--- a/ghc/compiler/types/Type.lhs
+++ b/ghc/compiler/types/Type.lhs
@@ -65,7 +65,7 @@ module Type (
        -- Type substitutions
        TvSubstEnv, emptyTvSubstEnv,    -- Representation widely visible
        TvSubst(..), emptyTvSubst,      -- Representation visible to a few friends
-       mkTvSubst, zipTvSubst, zipTopTvSubst, mkTopTvSubst, notElemTvSubst,
+       mkTvSubst, mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst, notElemTvSubst,
        getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope,
        extendTvSubst, extendTvSubstList, isInScope, composeTvSubst,
 
@@ -1031,12 +1031,13 @@ emptyTvSubstEnv = emptyVarEnv
 composeTvSubst :: InScopeSet -> TvSubstEnv -> TvSubstEnv -> TvSubstEnv
 -- (compose env1 env2)(x) is env1(env2(x)); i.e. apply env2 then env1
 -- It assumes that both are idempotent
+-- Typically, env1 is the refinement to a base substitution env2
 composeTvSubst in_scope env1 env2
   = env1 `plusVarEnv` mapVarEnv (substTy subst1) env2
        -- First apply env1 to the range of env2
        -- Then combine the two, making sure that env1 loses if
        -- both bind the same variable; that's why env1 is the
-       -- *left* argument to plusVarEnv, becuause the right arg wins
+       -- *left* argument to plusVarEnv, because the right arg wins
   where
     subst1 = TvSubst in_scope env1
 
@@ -1044,6 +1045,9 @@ emptyTvSubst = TvSubst emptyInScopeSet emptyVarEnv
 isEmptyTvSubst :: TvSubst -> Bool
 isEmptyTvSubst (TvSubst _ env) = isEmptyVarEnv env
 
+mkTvSubst :: InScopeSet -> TvSubstEnv -> TvSubst
+mkTvSubst = TvSubst
+
 getTvSubstEnv :: TvSubst -> TvSubstEnv
 getTvSubstEnv (TvSubst _ env) = env
 
@@ -1069,16 +1073,15 @@ extendTvSubstList :: TvSubst -> [TyVar] -> [Type] -> TvSubst
 extendTvSubstList (TvSubst in_scope env) tvs tys 
   = TvSubst in_scope (extendVarEnvList env (tvs `zip` tys))
 
--- mkTvSubst and zipTvSubst generate the in-scope set from
+-- mkOpenTvSubst and zipOpenTvSubst generate the in-scope set from
 -- the types given; but it's just a thunk so with a bit of luck
 -- it'll never be evaluated
 
-mkTvSubst :: TvSubstEnv -> TvSubst
-mkTvSubst env 
-  = TvSubst (mkInScopeSet (tyVarsOfTypes (varEnvElts env))) env
+mkOpenTvSubst :: TvSubstEnv -> TvSubst
+mkOpenTvSubst env = TvSubst (mkInScopeSet (tyVarsOfTypes (varEnvElts env))) env
 
-zipTvSubst :: [TyVar] -> [Type] -> TvSubst
-zipTvSubst tyvars tys 
+zipOpenTvSubst :: [TyVar] -> [Type] -> TvSubst
+zipOpenTvSubst tyvars tys 
   = TvSubst (mkInScopeSet (tyVarsOfTypes tys)) (zipTyEnv tyvars tys)
 
 -- mkTopTvSubst is called when doing top-level substitutions.
@@ -1131,7 +1134,7 @@ instance Outputable TvSubst where
 
 \begin{code}
 substTyWith :: [TyVar] -> [Type] -> Type -> Type
-substTyWith tvs tys = substTy (zipTvSubst tvs tys)
+substTyWith tvs tys = substTy (zipOpenTvSubst tvs tys)
 
 substTy :: TvSubst -> Type  -> Type
 substTy subst ty | isEmptyTvSubst subst = ty