summaryrefslogtreecommitdiff
path: root/compiler/GHC/Core/Type.hs
diff options
context:
space:
mode:
authorYiyun Liu <yiyun.liu@tweag.io>2022-05-27 18:04:16 -0400
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-08-04 02:55:07 -0400
commit35aef18de6d04473da95cb5a19d5cc111ee7ec45 (patch)
tree6b7a91a7c48d913d48ad9cf5cc9c89efc263e03c /compiler/GHC/Core/Type.hs
parent97655ad88c42003bc5eeb5c026754b005229800c (diff)
downloadhaskell-35aef18de6d04473da95cb5a19d5cc111ee7ec45.tar.gz
Remove TCvSubst and use Subst for both term and type-level subst
This patch removes the TCvSubst data type and instead uses Subst as the environment for both term and type level substitution. This change is partially motivated by the existential type proposal, which will introduce types that contain expressions and therefore forces us to carry around an "IdSubstEnv" even when substituting for types. It also reduces the amount of code because "Subst" and "TCvSubst" share a lot of common operations. There isn't any noticeable impact on performance (geo. mean for ghc/alloc is around 0.0% but we have -94 loc and one less data type to worry abount). Currently, the "TCvSubst" data type for substitution on types is identical to the "Subst" data type except the former doesn't store "IdSubstEnv". Using "Subst" for type-level substitution means there will be a redundant field stored in the data type. However, in cases where the substitution starts from the expression, using "Subst" for type-level substitution saves us from having to project "Subst" into a "TCvSubst". This probably explains why the allocation is mostly even despite the redundant field. The patch deletes "TCvSubst" and moves "Subst" and its relevant functions from "GHC.Core.Subst" into "GHC.Core.TyCo.Subst". Substitution on expressions is still defined in "GHC.Core.Subst" so we don't have to expose the definition of "Expr" in the hs-boot file that "GHC.Core.TyCo.Subst" must import to refer to "IdSubstEnv" (whose codomain is "CoreExpr"). Most functions named fooTCvSubst are renamed into fooSubst with a few exceptions (e.g. "isEmptyTCvSubst" is a distinct function from "isEmptySubst"; the former ignores the emptiness of "IdSubstEnv"). These exceptions mainly exist for performance reasons and will go away when "Expr" and "Type" are mutually recursively defined (we won't be able to take those shortcuts if we can't make the assumption that expressions don't appear in types).
Diffstat (limited to 'compiler/GHC/Core/Type.hs')
-rw-r--r--compiler/GHC/Core/Type.hs33
1 files changed, 17 insertions, 16 deletions
diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs
index 166a56cabb..5e769acaa9 100644
--- a/compiler/GHC/Core/Type.hs
+++ b/compiler/GHC/Core/Type.hs
@@ -193,25 +193,26 @@ module GHC.Core.Type (
-- * Main type substitution data types
TvSubstEnv, -- Representation widely visible
- TCvSubst(..), -- Representation visible to a few friends
+ IdSubstEnv,
+ Subst(..), -- Representation visible to a few friends
-- ** Manipulating type substitutions
- emptyTvSubstEnv, emptyTCvSubst, mkEmptyTCvSubst,
+ emptyTvSubstEnv, emptySubst, mkEmptySubst,
- mkTCvSubst, zipTvSubst, mkTvSubstPrs,
+ mkSubst, zipTvSubst, mkTvSubstPrs,
zipTCvSubst,
- notElemTCvSubst,
- getTvSubstEnv, setTvSubstEnv,
- zapTCvSubst, getTCvInScope, getTCvSubstRangeFVs,
- extendTCvInScope, extendTCvInScopeList, extendTCvInScopeSet,
+ notElemSubst,
+ getTvSubstEnv,
+ zapSubst, getSubstInScope, setInScope, getSubstRangeTyCoFVs,
+ extendSubstInScope, extendSubstInScopeList, extendSubstInScopeSet,
extendTCvSubst, extendCvSubst,
extendTvSubst, extendTvSubstBinderAndInScope,
extendTvSubstList, extendTvSubstAndInScope,
extendTCvSubstList,
extendTvSubstWithClone,
extendTCvSubstWithClone,
- isInScope, composeTCvSubstEnv, composeTCvSubst, zipTyEnv, zipCoEnv,
- isEmptyTCvSubst, unionTCvSubst,
+ isInScope, composeTCvSubst, zipTyEnv, zipCoEnv,
+ isEmptySubst, unionSubst, isEmptyTCvSubst,
-- ** Performing substitution on types and kinds
substTy, substTys, substScaledTy, substScaledTys, substTyWith, substTysWith, substTheta,
@@ -486,7 +487,7 @@ expand_syn tvs rhs arg_tys
| null tvs = mkAppTys rhs arg_tys
| otherwise = go empty_subst tvs arg_tys
where
- empty_subst = mkEmptyTCvSubst in_scope
+ empty_subst = mkEmptySubst in_scope
in_scope = mkInScopeSet $ shallowTyCoVarsOfTypes $ arg_tys
-- The free vars of 'rhs' should all be bound by 'tenv',
-- so we only need the free vars of tys
@@ -550,7 +551,7 @@ expandTypeSynonyms :: Type -> Type
--
-- Keep this synchronized with 'synonymTyConsOfType'
expandTypeSynonyms ty
- = go (mkEmptyTCvSubst in_scope) ty
+ = go (mkEmptySubst in_scope) ty
where
in_scope = mkInScopeSet (tyCoVarsOfType ty)
@@ -1360,7 +1361,7 @@ piResultTy_maybe ty arg = case coreFullView ty of
FunTy { ft_res = res } -> Just res
ForAllTy (Bndr tv _) res
- -> let empty_subst = mkEmptyTCvSubst $ mkInScopeSet $
+ -> let empty_subst = mkEmptySubst $ mkInScopeSet $
tyCoVarsOfTypes [arg,res]
in Just (substTy (extendTCvSubst empty_subst tv arg) res)
@@ -1402,9 +1403,9 @@ piResultTys ty orig_args@(arg:args)
| otherwise
= pprPanic "piResultTys1" (ppr ty $$ ppr orig_args)
where
- init_subst = mkEmptyTCvSubst $ mkInScopeSet (tyCoVarsOfTypes (ty:orig_args))
+ init_subst = mkEmptySubst $ mkInScopeSet (tyCoVarsOfTypes (ty:orig_args))
- go :: TCvSubst -> Type -> [Type] -> Type
+ go :: Subst -> Type -> [Type] -> Type
go subst ty [] = substTyUnchecked subst ty
go subst ty all_args@(arg:args)
@@ -1641,7 +1642,7 @@ mk_cast_ty orig_ty co = go orig_ty
, let fvs = tyCoVarsOfCo co
= -- have to make sure that pushing the co in doesn't capture the bound var!
if tv `elemVarSet` fvs
- then let empty_subst = mkEmptyTCvSubst (mkInScopeSet fvs)
+ then let empty_subst = mkEmptySubst (mkInScopeSet fvs)
(subst, tv') = substVarBndr empty_subst tv
in ForAllTy (Bndr tv' vis) (substTy subst inner_ty `mk_cast_ty` co)
else ForAllTy (Bndr tv vis) (inner_ty `mk_cast_ty` co)
@@ -2281,7 +2282,7 @@ appTyArgFlags ty = fun_kind_arg_flags (typeKind ty)
-- kind aligns with the corresponding position in the argument kind), determine
-- each argument's visibility ('Inferred', 'Specified', or 'Required').
fun_kind_arg_flags :: Kind -> [Type] -> [ArgFlag]
-fun_kind_arg_flags = go emptyTCvSubst
+fun_kind_arg_flags = go emptySubst
where
go subst ki arg_tys
| Just ki' <- coreView ki = go subst ki' arg_tys