summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBartosz Nitka <niteria@gmail.com>2016-01-26 11:59:37 -0800
committerBartosz Nitka <niteria@gmail.com>2016-01-27 07:17:19 -0800
commit5dcae88bd0df440abe78c3d793d21aca6236fc25 (patch)
tree4170ca2e8a500c03c1923071dcd5aa052c533cdd
parent00cbbab3362578df44851442408a8b91a2a769fa (diff)
downloadhaskell-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.hs2
-rw-r--r--compiler/basicTypes/MkId.hs4
-rw-r--r--compiler/coreSyn/CoreUtils.hs2
-rw-r--r--compiler/deSugar/Check.hs2
-rw-r--r--compiler/deSugar/DsExpr.hs2
-rw-r--r--compiler/iface/BuildTyCl.hs6
-rw-r--r--compiler/iface/TcIface.hs2
-rw-r--r--compiler/main/InteractiveEval.hs6
-rw-r--r--compiler/typecheck/TcDeriv.hs8
-rw-r--r--compiler/typecheck/TcFlatten.hs2
-rw-r--r--compiler/typecheck/TcInstDcls.hs2
-rw-r--r--compiler/typecheck/TcPat.hs4
-rw-r--r--compiler/typecheck/TcTyDecls.hs2
-rw-r--r--compiler/typecheck/TcType.hs6
-rw-r--r--compiler/types/FamInstEnv.hs2
-rw-r--r--compiler/types/OptCoercion.hs4
-rw-r--r--compiler/types/TyCoRep.hs70
-rw-r--r--compiler/types/Type.hs10
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