diff options
author | Bartosz Nitka <niteria@gmail.com> | 2016-01-26 11:59:37 -0800 |
---|---|---|
committer | Bartosz Nitka <niteria@gmail.com> | 2016-01-27 07:17:19 -0800 |
commit | 5dcae88bd0df440abe78c3d793d21aca6236fc25 (patch) | |
tree | 4170ca2e8a500c03c1923071dcd5aa052c533cdd | |
parent | 00cbbab3362578df44851442408a8b91a2a769fa (diff) | |
download | haskell-5dcae88bd0df440abe78c3d793d21aca6236fc25.tar.gz |
Rename "open" subst functions
This is the renaming that @simonpj requested:
```
· zipOpenTCvSubst -> zipTvSubst (It only deals with tyvars)
· zipOpenTCvSubstCoVars -> zipCvSubst (it only deals with
covars)
· zipOpenTCvSubstBinders -> zipTyBinderSubst (it only deals
with TyBinders, not covars)
```
plus the `mk` variant.
Test Plan: ./validate
Reviewers: simonpj, goldfire, austin, bgamari
Subscribers: thomie, simonpj
Differential Revision: https://phabricator.haskell.org/D1853
GHC Trac Issues: #11371
-rw-r--r-- | compiler/basicTypes/DataCon.hs | 2 | ||||
-rw-r--r-- | compiler/basicTypes/MkId.hs | 4 | ||||
-rw-r--r-- | compiler/coreSyn/CoreUtils.hs | 2 | ||||
-rw-r--r-- | compiler/deSugar/Check.hs | 2 | ||||
-rw-r--r-- | compiler/deSugar/DsExpr.hs | 2 | ||||
-rw-r--r-- | compiler/iface/BuildTyCl.hs | 6 | ||||
-rw-r--r-- | compiler/iface/TcIface.hs | 2 | ||||
-rw-r--r-- | compiler/main/InteractiveEval.hs | 6 | ||||
-rw-r--r-- | compiler/typecheck/TcDeriv.hs | 8 | ||||
-rw-r--r-- | compiler/typecheck/TcFlatten.hs | 2 | ||||
-rw-r--r-- | compiler/typecheck/TcInstDcls.hs | 2 | ||||
-rw-r--r-- | compiler/typecheck/TcPat.hs | 4 | ||||
-rw-r--r-- | compiler/typecheck/TcTyDecls.hs | 2 | ||||
-rw-r--r-- | compiler/typecheck/TcType.hs | 6 | ||||
-rw-r--r-- | compiler/types/FamInstEnv.hs | 2 | ||||
-rw-r--r-- | compiler/types/OptCoercion.hs | 4 | ||||
-rw-r--r-- | compiler/types/TyCoRep.hs | 70 | ||||
-rw-r--r-- | compiler/types/Type.hs | 10 |
18 files changed, 64 insertions, 72 deletions
diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs index 8bf91d0bb8..062683629e 100644 --- a/compiler/basicTypes/DataCon.hs +++ b/compiler/basicTypes/DataCon.hs @@ -974,7 +974,7 @@ dataConInstSig (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs , substTheta subst (eqSpecPreds eq_spec ++ theta) , substTys subst arg_tys) where - univ_subst = zipOpenTCvSubst univ_tvs univ_tys + univ_subst = zipTvSubst univ_tvs univ_tys (subst, ex_tvs') = mapAccumL Type.substTyVarBndr univ_subst ex_tvs diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index f3063e9fb2..c7ef602081 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -522,7 +522,7 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con where (univ_tvs, ex_tvs, eq_spec, theta, orig_arg_tys, _orig_res_ty) = dataConFullSig data_con - res_ty_args = substTyVars (mkTopTCvSubst (map eqSpecPair eq_spec)) univ_tvs + res_ty_args = substTyVars (mkTvSubstPrs (map eqSpecPair eq_spec)) univ_tvs tycon = dataConTyCon data_con -- The representation TyCon (not family) wrap_ty = dataConUserType data_con @@ -563,7 +563,7 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con mk_boxer :: [Boxer] -> DataConBoxer mk_boxer boxers = DCB (\ ty_args src_vars -> do { let (ex_vars, term_vars) = splitAtList ex_tvs src_vars - subst1 = mkTopTCvSubst (univ_tvs `zip` ty_args) + subst1 = mkTvSubstPrs (univ_tvs `zip` ty_args) subst2 = extendTCvSubstList subst1 ex_tvs (mkTyVarTys ex_vars) ; (rep_ids, binds) <- go subst2 boxers term_vars diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs index a403f290ec..8bea570383 100644 --- a/compiler/coreSyn/CoreUtils.hs +++ b/compiler/coreSyn/CoreUtils.hs @@ -1557,7 +1557,7 @@ dataConInstPat fss uniqs con inst_tys (ex_fss, id_fss) = splitAt n_ex fss -- Make the instantiating substitution for universals - univ_subst = zipOpenTCvSubst univ_tvs inst_tys + univ_subst = zipTvSubst univ_tvs inst_tys -- Make existential type variables, applyingn and extending the substitution (full_subst, ex_bndrs) = mapAccumL mk_ex_var univ_subst diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index 73f0177342..043b4f2a04 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -723,7 +723,7 @@ mkOneConFull x usupply con = (con_abs, constraints) Just (tc, tys) -> ASSERT( tc == data_tc ) tys Nothing -> pprPanic "mkOneConFull: Not TyConApp:" (ppr res_ty) - subst1 = zipOpenTCvSubst univ_tvs tc_args + subst1 = zipTvSubst univ_tvs tc_args (subst, ex_tvs') = cloneTyVarBndrs subst1 ex_tvs usupply1 diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs index dce8f2fa5b..27cb4b8c3b 100644 --- a/compiler/deSugar/DsExpr.hs +++ b/compiler/deSugar/DsExpr.hs @@ -623,7 +623,7 @@ dsExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = fields mk_alt upd_fld_env con = do { let (univ_tvs, ex_tvs, eq_spec, prov_theta, _req_theta, arg_tys, _) = conLikeFullSig con - subst = mkTopTCvSubst (univ_tvs `zip` in_inst_tys) + subst = mkTvSubstPrs (univ_tvs `zip` in_inst_tys) -- I'm not bothering to clone the ex_tvs ; eqs_vars <- mapM newPredVarDs (substTheta subst (eqSpecPreds eq_spec)) diff --git a/compiler/iface/BuildTyCl.hs b/compiler/iface/BuildTyCl.hs index 1b4017abdc..bde9019ce1 100644 --- a/compiler/iface/BuildTyCl.hs +++ b/compiler/iface/BuildTyCl.hs @@ -157,7 +157,7 @@ mkDataConStupidTheta tycon arg_tys univ_tvs | null stupid_theta = [] -- The common case | otherwise = filter in_arg_tys stupid_theta where - tc_subst = zipOpenTCvSubst (tyConTyVars tycon) (mkTyVarTys univ_tvs) + tc_subst = zipTvSubst (tyConTyVars tycon) (mkTyVarTys univ_tvs) stupid_theta = substTheta tc_subst (tyConStupidTheta tycon) -- Start by instantiating the master copy of the -- stupid theta, taken from the TyCon @@ -205,8 +205,8 @@ buildPatSyn src_name declared_infix matcher@(matcher_id,_) builder (ex_tvs1, prov_theta1, cont_tau) = tcSplitSigmaTy cont_sigma (arg_tys1, _) = tcSplitFunTys cont_tau twiddle = char '~' - subst = zipOpenTCvSubst (univ_tvs1 ++ ex_tvs1) - (mkTyVarTys (univ_tvs ++ ex_tvs)) + subst = zipTvSubst (univ_tvs1 ++ ex_tvs1) + (mkTyVarTys (univ_tvs ++ ex_tvs)) ------------------------------------------------------ type TcMethInfo = (Name, Type, Maybe (DefMethSpec Type)) diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs index 9d1886d27c..2e8a6ed796 100644 --- a/compiler/iface/TcIface.hs +++ b/compiler/iface/TcIface.hs @@ -569,7 +569,7 @@ tcIfaceDataCons tycon_name tycon tc_tyvars if_cons -- Remember, tycon is the representation tycon ; let orig_res_ty = mkFamilyTyConApp tycon - (substTyVars (mkTopTCvSubst (map eqSpecPair eq_spec)) + (substTyVars (mkTvSubstPrs (map eqSpecPair eq_spec)) tc_tyvars) ; prom_rep_name <- newTyConRepName dc_name diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index f0df270044..b66a4f8c82 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -577,9 +577,9 @@ bindLocalsAtBreakpoint hsc_env apStack_fhv (Just BreakInfo{..}) = do -- Similarly, clone the type variables mentioned in the types -- we have here, *and* make them all RuntimeUnk tyars newTyVars us tvs - = mkTopTCvSubst [ (tv, mkTyVarTy (mkRuntimeUnkTyVar name (tyVarKind tv))) - | (tv, uniq) <- varSetElems tvs `zip` uniqsFromSupply us - , let name = setNameUnique (tyVarName tv) uniq ] + = mkTvSubstPrs [ (tv, mkTyVarTy (mkRuntimeUnkTyVar name (tyVarKind tv))) + | (tv, uniq) <- varSetElems tvs `zip` uniqsFromSupply us + , let name = setNameUnique (tyVarName tv) uniq ] rttiEnvironment :: HscEnv -> IO HscEnv rttiEnvironment hsc_env@HscEnv{hsc_IC=ic} = do diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index 88fc1ad08a..7946bb594a 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -1002,13 +1002,13 @@ inferConstraints main_cls cls_tys inst_ty rep_tc rep_tc_args mkThetaOrigin DerivOrigin TypeLevel $ substTheta cls_subst (classSCTheta main_cls) cls_subst = ASSERT( equalLength cls_tvs inst_tys ) - zipOpenTCvSubst cls_tvs inst_tys + zipTvSubst cls_tvs inst_tys -- Stupid constraints stupid_constraints = mkThetaOrigin DerivOrigin TypeLevel $ substTheta tc_subst (tyConStupidTheta rep_tc) tc_subst = ASSERT( equalLength rep_tc_tvs all_rep_tc_args ) - zipOpenTCvSubst rep_tc_tvs all_rep_tc_args + zipTvSubst rep_tc_tvs all_rep_tc_args -- Extra Data constraints -- The Data class (only) requires that for @@ -1574,7 +1574,7 @@ mkNewTypeEqn dflags overlap_mode tvs inst_ty = mkTyConApp tycon tc_args inst_tys = cls_tys ++ [inst_ty] sc_theta = mkThetaOrigin DerivOrigin TypeLevel $ - substTheta (zipOpenTCvSubst cls_tyvars inst_tys) $ + substTheta (zipTvSubst cls_tyvars inst_tys) $ classSCTheta cls -- Next we collect Coercible constraints between @@ -1889,7 +1889,7 @@ simplifyDeriv pred tvs theta ; let min_theta = mkMinimalBySCs (bagToList good) - subst_skol = zipOpenTCvSubst tvs_skols $ mkTyVarTys tvs + subst_skol = zipTvSubst tvs_skols $ mkTyVarTys tvs -- The reverse substitution (sigh) ; return (substTheta subst_skol min_theta) } diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs index f87a302d5c..0ab946b052 100644 --- a/compiler/typecheck/TcFlatten.hs +++ b/compiler/typecheck/TcFlatten.hs @@ -956,7 +956,7 @@ flatten_one (TyConApp tc tys) -- Expand type synonyms that mention type families -- on the RHS; see Note [Flattening synonyms] | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys - , let expanded_ty = mkAppTys (substTy (mkTopTCvSubst tenv) rhs) tys' + , let expanded_ty = mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys' = do { mode <- getMode ; let used_tcs = tyConsOfType rhs ; case mode of diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs index 50850ae16c..48a8b99d2a 100644 --- a/compiler/typecheck/TcInstDcls.hs +++ b/compiler/typecheck/TcInstDcls.hs @@ -791,7 +791,7 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds }) ; let (clas, inst_tys) = tcSplitDFunHead inst_head (class_tyvars, sc_theta, _, op_items) = classBigSig clas - sc_theta' = substTheta (zipOpenTCvSubst class_tyvars inst_tys) sc_theta + sc_theta' = substTheta (zipTvSubst class_tyvars inst_tys) sc_theta ; traceTc "tcInstDecl2" (vcat [ppr inst_tyvars, ppr inst_tys, ppr dfun_theta, ppr sc_theta']) diff --git a/compiler/typecheck/TcPat.hs b/compiler/typecheck/TcPat.hs index ce2d16a5d5..2dddd6b721 100644 --- a/compiler/typecheck/TcPat.hs +++ b/compiler/typecheck/TcPat.hs @@ -737,7 +737,7 @@ tcDataConPat penv (L con_span con_name) data_con pat_ty arg_pats thing_inside ; let all_arg_tys = eqSpecPreds eq_spec ++ theta ++ arg_tys ; checkExistentials ex_tvs all_arg_tys penv ; (tenv, ex_tvs') <- tcInstSuperSkolTyVarsX - (zipOpenTCvSubst univ_tvs ctxt_res_tys) ex_tvs + (zipTvSubst univ_tvs ctxt_res_tys) ex_tvs -- Get location from monad, not from ex_tvs ; let -- pat_ty' = mkTyConApp tycon ctxt_res_tys @@ -1011,7 +1011,7 @@ addDataConStupidTheta data_con inst_tys -- The origin should always report "occurrence of C" -- even when C occurs in a pattern stupid_theta = dataConStupidTheta data_con - tenv = mkTopTCvSubst (dataConUnivTyVars data_con `zip` inst_tys) + tenv = mkTvSubstPrs (dataConUnivTyVars data_con `zip` inst_tys) -- NB: inst_tys can be longer than the univ tyvars -- because the constructor might have existentials inst_theta = substTheta tenv stupid_theta diff --git a/compiler/typecheck/TcTyDecls.hs b/compiler/typecheck/TcTyDecls.hs index 2517c46a2c..314e20c7ae 100644 --- a/compiler/typecheck/TcTyDecls.hs +++ b/compiler/typecheck/TcTyDecls.hs @@ -1017,7 +1017,7 @@ mkOneRecordSelector all_cons idDetails fl (univ_tvs, _, eq_spec, _, req_theta, _, data_ty) = conLikeFullSig con1 - eq_subst = mkTopTCvSubst (map eqSpecPair eq_spec) + eq_subst = mkTvSubstPrs (map eqSpecPair eq_spec) inst_tys = substTyVars eq_subst univ_tvs unit_rhs = mkLHsTupleExpr [] diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 54be1d6e31..29e7a6b869 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -146,8 +146,8 @@ module TcType ( -- Type substitutions TCvSubst(..), -- Representation visible to a few friends TvSubstEnv, emptyTCvSubst, - mkOpenTCvSubst, zipOpenTCvSubst, - mkTopTCvSubst, notElemTCvSubst, unionTCvSubst, + zipTvSubst, + mkTvSubstPrs, notElemTCvSubst, unionTCvSubst, getTvSubstEnv, setTvSubstEnv, getTCvInScope, extendTCvInScope, extendTCvInScopeList, extendTCvInScopeSet, extendTCvSubstAndInScope, Type.lookupTyVar, Type.extendTCvSubst, Type.substTyVarBndr, @@ -1757,7 +1757,7 @@ transSuperClasses p immSuperClasses :: Class -> [Type] -> [PredType] immSuperClasses cls tys - = substTheta (zipOpenTCvSubst tyvars tys) sc_theta + = substTheta (zipTvSubst tyvars tys) sc_theta where (tyvars,sc_theta,_,_) = classBigSig cls diff --git a/compiler/types/FamInstEnv.hs b/compiler/types/FamInstEnv.hs index 4b4cc5d2f6..b4cbf53397 100644 --- a/compiler/types/FamInstEnv.hs +++ b/compiler/types/FamInstEnv.hs @@ -1237,7 +1237,7 @@ normalise_tc_app tc tys ; case expandSynTyCon_maybe tc ntys of { Just (tenv, rhs, ntys') -> do { (co2, ninst_rhs) - <- normalise_type (substTy (mkTopTCvSubst tenv) rhs) + <- normalise_type (substTy (mkTvSubstPrs tenv) rhs) ; return $ if isReflCo co2 then (args_co, mkTyConApp tc ntys) diff --git a/compiler/types/OptCoercion.hs b/compiler/types/OptCoercion.hs index b867259636..c9db4b3e67 100644 --- a/compiler/types/OptCoercion.hs +++ b/compiler/types/OptCoercion.hs @@ -722,8 +722,8 @@ checkAxInstCo (AxiomInstCo ax ind cos) incomps = coAxBranchIncomps branch (tys, cotys) = splitAtList tvs (map (pFst . coercionKind) cos) co_args = map stripCoercionTy cotys - subst = zipOpenTCvSubst tvs tys `composeTCvSubst` - zipOpenTCvSubstCoVars cvs co_args + subst = zipTvSubst tvs tys `composeTCvSubst` + zipCvSubst cvs co_args target = Type.substTys subst (coAxBranchLHS branch) in_scope = mkInScopeSet $ unionVarSets (map (tyCoVarsOfTypes . coAxBranchLHS) incomps) diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index dcffbe037c..4bc9f59053 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -82,9 +82,9 @@ module TyCoRep ( extendTCvSubst, extendTCvSubstAndInScope, extendTCvSubstList, extendTCvSubstBinder, unionTCvSubst, zipTyEnv, zipCoEnv, mkTyCoInScopeSet, - mkOpenTCvSubst, zipOpenTCvSubst, zipOpenTCvSubstCoVars, - zipOpenTCvSubstBinders, - mkTopTCvSubst, + zipTvSubst, zipCvSubst, + zipTyBinderSubst, + mkTvSubstPrs, substTelescope, substTyWith, substTyWithCoVars, substTysWith, substTysWithCoVars, @@ -1637,7 +1637,7 @@ unionTCvSubst (TCvSubst in_scope1 tenv1 cenv1) (TCvSubst in_scope2 tenv2 cenv2) (tenv1 `plusVarEnv` tenv2) (cenv1 `plusVarEnv` cenv2) --- mkOpenTCvSubst and zipOpenTCvSubst generate the in-scope set from +-- mkTvSubstPrs and zipTvSubst 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 @@ -1648,50 +1648,46 @@ mkTyCoInScopeSet tys cos = mkInScopeSet (tyCoVarsOfTypes tys `unionVarSet` tyCoVarsOfCos cos) -- | Generates the in-scope set for the 'TCvSubst' from the types in the incoming --- environment, hence "open" -mkOpenTCvSubst :: TvSubstEnv -> CvSubstEnv -> TCvSubst -mkOpenTCvSubst tenv cenv - = TCvSubst (mkTyCoInScopeSet (varEnvElts tenv) (varEnvElts cenv)) tenv cenv - --- | Generates the in-scope set for the 'TCvSubst' from the types in the incoming --- environment, hence "open". No CoVars, please! -zipOpenTCvSubst :: [TyVar] -> [Type] -> TCvSubst -zipOpenTCvSubst tvs tys +-- environment. No CoVars, please! +zipTvSubst :: [TyVar] -> [Type] -> TCvSubst +zipTvSubst tvs tys | debugIsOn , not (all isTyVar tvs) || length tvs /= length tys - = pprTrace "zipOpenTCvSubst" (ppr tvs $$ ppr tys) emptyTCvSubst + = pprTrace "zipTvSubst" (ppr tvs $$ ppr tys) emptyTCvSubst | otherwise = TCvSubst (mkInScopeSet (tyCoVarsOfTypes tys)) tenv emptyCvSubstEnv where tenv = zipTyEnv tvs tys -- | Generates the in-scope set for the 'TCvSubst' from the types in the incoming --- environment, hence "open". No TyVars, please! -zipOpenTCvSubstCoVars :: [CoVar] -> [Coercion] -> TCvSubst -zipOpenTCvSubstCoVars cvs cos +-- environment. No TyVars, please! +zipCvSubst :: [CoVar] -> [Coercion] -> TCvSubst +zipCvSubst cvs cos | debugIsOn , not (all isCoVar cvs) || length cvs /= length cos - = pprTrace "zipOpenTCvSubstCoVars" (ppr cvs $$ ppr cos) emptyTCvSubst + = pprTrace "zipCvSubst" (ppr cvs $$ ppr cos) emptyTCvSubst | otherwise = TCvSubst (mkInScopeSet (tyCoVarsOfCos cos)) emptyTvSubstEnv cenv where cenv = zipCoEnv cvs cos --- | Create an open TCvSubst combining the binders and types provided. +-- | Create a TCvSubst combining the binders and types provided. -- NB: It is specifically OK if the lists are of different lengths. -zipOpenTCvSubstBinders :: [TyBinder] -> [Type] -> TCvSubst -zipOpenTCvSubstBinders bndrs tys +zipTyBinderSubst :: [TyBinder] -> [Type] -> TCvSubst +zipTyBinderSubst bndrs tys = TCvSubst is tenv emptyCvSubstEnv where is = mkInScopeSet (tyCoVarsOfTypes tys) tenv = mkVarEnv [ (tv, ty) | (Named tv _, ty) <- zip bndrs tys ] --- | Called when doing top-level substitutions. No CoVars, please! -mkTopTCvSubst :: [(TyVar, Type)] -> TCvSubst -mkTopTCvSubst prs = +-- | Generates the in-scope set for the 'TCvSubst' from the types in the +-- incoming environment. No CoVars, please! +mkTvSubstPrs :: [(TyVar, Type)] -> TCvSubst +mkTvSubstPrs prs = ASSERT2( onlyTyVarsAndNoCoercionTy, text "prs" <+> ppr prs ) - mkOpenTCvSubst tenv emptyCvSubstEnv + TCvSubst in_scope tenv emptyCvSubstEnv where tenv = mkVarEnv prs + in_scope = mkInScopeSet $ tyCoVarsOfTypes $ map snd prs onlyTyVarsAndNoCoercionTy = and [ isTyVar tv && not (isCoercionTy ty) | (tv, ty) <- prs ] @@ -1785,11 +1781,10 @@ substTelescope = go_subst emptyTCvSubst go_subst _ _ _ = panic "substTelescope" --- | Type substitution making use of an 'TCvSubst' that --- is assumed to be open, see 'zipOpenTCvSubst' +-- | Type substitution, see 'zipTvSubst' substTyWith :: [TyVar] -> [Type] -> Type -> Type substTyWith tvs tys = ASSERT( length tvs == length tys ) - substTyUnchecked (zipOpenTCvSubst tvs tys) + substTyUnchecked (zipTvSubst tvs tys) -- | Substitute tyvars within a type using a known 'InScopeSet'. -- Pre-condition: the 'in_scope' set should satisfy Note [The substitution @@ -1801,33 +1796,30 @@ substTyWithInScope in_scope tvs tys ty = substTy (mkTCvSubst in_scope (tenv, emptyCvSubstEnv)) ty where tenv = zipTyEnv tvs tys --- | Coercion substitution making use of an 'TCvSubst' that --- is assumed to be open, see 'zipOpenTCvSubst' +-- | Coercion substitution, see 'zipTvSubst' substCoWith :: [TyVar] -> [Type] -> Coercion -> Coercion substCoWith tvs tys = ASSERT( length tvs == length tys ) - substCo (zipOpenTCvSubst tvs tys) + substCo (zipTvSubst tvs tys) -- | Substitute covars within a type substTyWithCoVars :: [CoVar] -> [Coercion] -> Type -> Type -substTyWithCoVars cvs cos = substTy (zipOpenTCvSubstCoVars cvs cos) +substTyWithCoVars cvs cos = substTy (zipCvSubst cvs cos) --- | Type substitution making use of an 'TCvSubst' that --- is assumed to be open, see 'zipOpenTCvSubst' +-- | Type substitution, see 'zipTvSubst' substTysWith :: [TyVar] -> [Type] -> [Type] -> [Type] substTysWith tvs tys = ASSERT( length tvs == length tys ) - substTys (zipOpenTCvSubst tvs tys) + substTys (zipTvSubst tvs tys) --- | Type substitution making use of an 'TCvSubst' that --- is assumed to be open, see 'zipOpenTCvSubst' +-- | Type substitution, see 'zipTvSubst' substTysWithCoVars :: [CoVar] -> [Coercion] -> [Type] -> [Type] substTysWithCoVars cvs cos = ASSERT( length cvs == length cos ) - substTys (zipOpenTCvSubstCoVars cvs cos) + substTys (zipCvSubst cvs cos) -- | Type substitution using 'Binder's. Anonymous binders -- simply ignore their matching type. substTyWithBinders :: [TyBinder] -> [Type] -> Type -> Type substTyWithBinders bndrs tys = ASSERT( length bndrs == length tys ) - substTyUnchecked (zipOpenTCvSubstBinders bndrs tys) + substTyUnchecked (zipTyBinderSubst bndrs tys) -- | Substitute within a 'Type' after adding the free variables of the type -- to the in-scope set. This is useful for the case when the free variables diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 3992a7108c..74763dae94 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -150,7 +150,7 @@ module Type ( -- ** Manipulating type substitutions emptyTvSubstEnv, emptyTCvSubst, mkEmptyTCvSubst, - mkTCvSubst, mkOpenTCvSubst, zipOpenTCvSubst, mkTopTCvSubst, + mkTCvSubst, zipTvSubst, mkTvSubstPrs, notElemTCvSubst, getTvSubstEnv, setTvSubstEnv, zapTCvSubst, getTCvInScope, @@ -294,7 +294,7 @@ coreView :: Type -> Maybe Type -- By being non-recursive and inlined, this case analysis gets efficiently -- joined onto the case analysis that the caller is already doing coreView (TyConApp tc tys) | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys - = Just (mkAppTys (substTy (mkTopTCvSubst tenv) rhs) tys') + = Just (mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys') -- The free vars of 'rhs' should all be bound by 'tenv', so it's -- ok to use 'substTy' here. -- See also Note [The substitution invariant] in TyCoRep. @@ -326,7 +326,7 @@ expandTypeSynonyms ty where go subst (TyConApp tc tys) | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys - = let subst' = unionTCvSubst subst (mkTopTCvSubst tenv) in + = let subst' = unionTCvSubst subst (mkTvSubstPrs tenv) in go subst' (mkAppTys rhs tys') | otherwise = TyConApp tc (map (go subst) tys) @@ -1015,7 +1015,7 @@ mkCastTy ty co = -- NB: don't check if the coercion "from" type matches here; = let (bndrs, _inner_ki) = splitPiTys kind (no_dep_bndrs, some_dep_bndrs) = spanEnd isAnonBinder bndrs (some_dep_args, rest_args) = splitAtList some_dep_bndrs args - dep_subst = zipOpenTCvSubstBinders some_dep_bndrs some_dep_args + dep_subst = zipTyBinderSubst some_dep_bndrs some_dep_args used_no_dep_bndrs = takeList rest_args no_dep_bndrs rest_arg_tys = substTys dep_subst (map binderType used_no_dep_bndrs) co' = mkFunCos Nominal @@ -1813,7 +1813,7 @@ mkFamilyTyConApp tc tys | Just (fam_tc, fam_tys) <- tyConFamInst_maybe tc , let tvs = tyConTyVars tc fam_subst = ASSERT2( length tvs == length tys, ppr tc <+> ppr tys ) - zipOpenTCvSubst tvs tys + zipTvSubst tvs tys = mkTyConApp fam_tc (substTys fam_subst fam_tys) | otherwise = mkTyConApp tc tys |