From 04612d54b51bebf809717d1cf0242efb6294ee59 Mon Sep 17 00:00:00 2001 From: simonpj Date: Mon, 31 Jan 2005 13:23:17 +0000 Subject: [PATCH] [project @ 2005-01-31 13:22:57 by simonpj] Rename mkTvSubst to mkOpenTvSubst; add new mkTvSubst --- ghc/compiler/typecheck/TcBinds.lhs | 4 ++-- ghc/compiler/typecheck/TcDeriv.lhs | 4 ++-- ghc/compiler/typecheck/TcInstDcls.lhs | 6 +++--- ghc/compiler/typecheck/TcPat.lhs | 4 ++-- ghc/compiler/typecheck/TcType.lhs | 4 ++-- ghc/compiler/types/Type.lhs | 21 ++++++++++++--------- 6 files changed, 23 insertions(+), 20 deletions(-) diff --git a/ghc/compiler/typecheck/TcBinds.lhs b/ghc/compiler/typecheck/TcBinds.lhs index 395744d..509bce7 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 -- 1.7.10.4