diff options
author | Yiyun Liu <yiyun.liu@tweag.io> | 2022-05-27 18:04:16 -0400 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-08-04 02:55:07 -0400 |
commit | 35aef18de6d04473da95cb5a19d5cc111ee7ec45 (patch) | |
tree | 6b7a91a7c48d913d48ad9cf5cc9c89efc263e03c /compiler/GHC/Core/Type.hs | |
parent | 97655ad88c42003bc5eeb5c026754b005229800c (diff) | |
download | haskell-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.hs | 33 |
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 |