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

Rename mkTvSubst to mkOpenTvSubst; add new mkTvSubst

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, 

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

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]

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

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,

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