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).

1 files changed, 33 insertions, 165 deletions

diff --git a/compiler/GHC/Core/Subst.hs b/compiler/GHC/Core/Subst.hs
index 12a3e79559..8d5fd9422c 100644
--- a/compiler/GHC/Core/Subst.hs
+++ b/compiler/GHC/Core/Subst.hs
@@ -15,18 +15,19 @@ module GHC.Core.Subst (
 
         -- ** Substituting into expressions and related types
         deShadowBinds, substRuleInfo, substRulesForImportedIds,
-        substTy, substCo, substExpr, substExprSC, substBind, substBindSC,
+        substTyUnchecked, substCo, substExpr, substExprSC, substBind, substBindSC,
         substUnfolding, substUnfoldingSC,
         lookupIdSubst, substIdType, substIdOcc,
         substTickish, substDVarSet, substIdInfo,
 
         -- ** Operations on substitutions
-        emptySubst, mkEmptySubst, mkSubst, mkOpenSubst, substInScope, isEmptySubst,
+        emptySubst, mkEmptySubst, mkSubst, mkOpenSubst, isEmptySubst,
         extendIdSubst, extendIdSubstList, extendTCvSubst, extendTvSubstList,
-        extendSubst, extendSubstList, extendSubstWithVar, zapSubstEnv,
+        extendIdSubstWithClone,
+        extendSubst, extendSubstList, extendSubstWithVar,
         extendSubstInScope, extendSubstInScopeList, extendSubstInScopeSet,
-        isInScope, setInScope, getTCvSubst, extendTvSubst, extendCvSubst,
-        delBndr, delBndrs,
+        isInScope, setInScope, extendTvSubst, extendCvSubst,
+        delBndr, delBndrs, zapSubst,
 
         -- ** Substituting and cloning binders
         substBndr, substBndrs, substRecBndrs, substTyVarBndr, substCoVarBndr,
@@ -40,14 +41,12 @@ import GHC.Core
 import GHC.Core.FVs
 import GHC.Core.Seq
 import GHC.Core.Utils
-import qualified GHC.Core.Type as Type
-import qualified GHC.Core.Coercion as Coercion
+import GHC.Core.TyCo.Subst ( substCo )
 
         -- We are defining local versions
-import GHC.Core.Type hiding
-   ( substTy, extendTvSubst, extendCvSubst, extendTvSubstList
-   , isInScope, substTyVarBndr, cloneTyVarBndr )
-import GHC.Core.Coercion hiding ( substCo, substCoVarBndr )
+import GHC.Core.Type hiding ( substTy )
+import GHC.Core.Coercion
+    ( tyCoFVsOfCo, mkCoVarCo, substCoVarBndr )
 
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env as InScopeSet
@@ -68,8 +67,6 @@ import GHC.Utils.Panic.Plain
 
 import Data.List (mapAccumL)
 
-
-
 {-
 ************************************************************************
 *                                                                      *
@@ -78,37 +75,12 @@ import Data.List (mapAccumL)
 ************************************************************************
 -}
 
--- | A substitution environment, containing 'Id', 'TyVar', and 'CoVar'
--- substitutions.
---
--- Some invariants apply to how you use the substitution:
---
--- 1. Note [The substitution invariant] in "GHC.Core.TyCo.Subst"
---
--- 2. Note [Substitutions apply only once] in "GHC.Core.TyCo.Subst"
-data Subst
-  = Subst InScopeSet  -- Variables in scope (both Ids and TyVars) /after/
-                      -- applying the substitution
-          IdSubstEnv  -- Substitution from NcIds to CoreExprs
-          TvSubstEnv  -- Substitution from TyVars to Types
-          CvSubstEnv  -- Substitution from CoVars to Coercions
-
-        -- INVARIANT 1: See TyCoSubst Note [The substitution invariant]
-        -- This is what lets us deal with name capture properly
-        -- It's a hard invariant to check...
-        --
-        -- INVARIANT 2: The substitution is apply-once;
-        --              see Note [Substitutions apply only once] in GHC.Core.TyCo.Subst
-        --
-        -- INVARIANT 3: See Note [Extending the Subst]
-
 {-
-Note [Extending the Subst]
+Note [Extending the IdSubstEnv]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~
-For a core Subst, which binds Ids as well, we make a different choice for Ids
-than we do for TyVars.
+We make a different choice for Ids than we do for TyVars.
 
-For TyVars, see Note [Extending the TCvSubstEnv] in GHC.Core.TyCo.Subst.
+For TyVars, see Note [Extending the TvSubstEnv and CvSubstEnv] in GHC.Core.TyCo.Subst.
 
 For Ids, we have a different invariant
         The IdSubstEnv is extended *only* when the Unique on an Id changes
@@ -158,31 +130,13 @@ TvSubstEnv and CvSubstEnv?
   easy to spot
 -}
 
--- | An environment for substituting for 'Id's
-type IdSubstEnv = IdEnv CoreExpr   -- Domain is NcIds, i.e. not coercions
-
 ----------------------------
-isEmptySubst :: Subst -> Bool
-isEmptySubst (Subst _ id_env tv_env cv_env)
-  = isEmptyVarEnv id_env && isEmptyVarEnv tv_env && isEmptyVarEnv cv_env
-
-emptySubst :: Subst
-emptySubst = Subst emptyInScopeSet emptyVarEnv emptyVarEnv emptyVarEnv
-
-mkEmptySubst :: InScopeSet -> Subst
-mkEmptySubst in_scope = Subst in_scope emptyVarEnv emptyVarEnv emptyVarEnv
 
-mkSubst :: InScopeSet -> TvSubstEnv -> CvSubstEnv -> IdSubstEnv -> Subst
-mkSubst in_scope tvs cvs ids = Subst in_scope ids tvs cvs
-
--- | Find the in-scope set: see "GHC.Core.TyCo.Subst" Note [The substitution invariant]
-substInScope :: Subst -> InScopeSet
-substInScope (Subst in_scope _ _ _) = in_scope
-
--- | Remove all substitutions for 'Id's and 'Var's that might have been built up
--- while preserving the in-scope set
-zapSubstEnv :: Subst -> Subst
-zapSubstEnv (Subst in_scope _ _ _) = Subst in_scope emptyVarEnv emptyVarEnv emptyVarEnv
+-- We keep GHC.Core.Subst separate from GHC.Core.TyCo.Subst to avoid creating
+-- circular dependencies. Functions in this file that don't depend on
+-- the definition of CoreExpr can be moved to GHC.Core.TyCo.Subst, as long
+-- as it does not require importing too many additional hs-boot files and
+-- cause a significant drop in performance.
 
 -- | Add a substitution for an 'Id' to the 'Subst': you must ensure that the in-scope set is
 -- such that TyCoSubst Note [The substitution invariant]
@@ -193,38 +147,20 @@ extendIdSubst (Subst in_scope ids tvs cvs) v r
   = assertPpr (isNonCoVarId v) (ppr v $$ ppr r) $
     Subst in_scope (extendVarEnv ids v r) tvs cvs
 
+extendIdSubstWithClone :: Subst -> Id -> Id -> Subst
+extendIdSubstWithClone (Subst in_scope ids tvs cvs) v v'
+  = assertPpr (isNonCoVarId v) (ppr v $$ ppr v') $
+    Subst (extendInScopeSetSet in_scope new_in_scope)
+          (extendVarEnv ids v (varToCoreExpr v')) tvs cvs
+    where
+      new_in_scope = tyCoVarsOfType (varType v') `extendVarSet` v'
+
 -- | Adds multiple 'Id' substitutions to the 'Subst': see also 'extendIdSubst'
 extendIdSubstList :: Subst -> [(Id, CoreExpr)] -> Subst
 extendIdSubstList (Subst in_scope ids tvs cvs) prs
   = assert (all (isNonCoVarId . fst) prs) $
     Subst in_scope (extendVarEnvList ids prs) tvs cvs
 
--- | Add a substitution for a 'TyVar' to the 'Subst'
--- The 'TyVar' *must* be a real TyVar, and not a CoVar
--- You must ensure that the in-scope set is such that
--- "GHC.Core.TyCo.Subst" Note [The substitution invariant] holds
--- after extending the substitution like this.
-extendTvSubst :: Subst -> TyVar -> Type -> Subst
-extendTvSubst (Subst in_scope ids tvs cvs) tv ty
-  = assert (isTyVar tv) $
-    Subst in_scope ids (extendVarEnv tvs tv ty) cvs
-
--- | Adds multiple 'TyVar' substitutions to the 'Subst': see also 'extendTvSubst'
-extendTvSubstList :: Subst -> [(TyVar,Type)] -> Subst
-extendTvSubstList subst vrs
-  = foldl' extend subst vrs
-  where
-    extend subst (v, r) = extendTvSubst subst v r
-
--- | Add a substitution from a 'CoVar' to a 'Coercion' to the 'Subst':
--- you must ensure that the in-scope set satisfies
--- "GHC.Core.TyCo.Subst" Note [The substitution invariant]
--- after extending the substitution like this
-extendCvSubst :: Subst -> CoVar -> Coercion -> Subst
-extendCvSubst (Subst in_scope ids tvs cvs) v r
-  = assert (isCoVar v) $
-    Subst in_scope ids tvs (extendVarEnv cvs v r)
-
 -- | Add a substitution appropriate to the thing being substituted
 --   (whether an expression, type, or coercion). See also
 --   'extendIdSubst', 'extendTvSubst', 'extendCvSubst'
@@ -254,7 +190,7 @@ lookupIdSubst (Subst in_scope ids _ _) v
   | not (isLocalId v) = Var v
   | Just e  <- lookupVarEnv ids       v = e
   | Just v' <- lookupInScope in_scope v = Var v'
-        -- Vital! See Note [Extending the Subst]
+        -- Vital! See Note [Extending the IdSubstEnv]
         -- If v isn't in the InScopeSet, we panic, because
         -- it's a bad bug and we reallly want to know
   | otherwise = pprPanic "lookupIdSubst" (ppr v $$ ppr in_scope)
@@ -281,41 +217,6 @@ mkOpenSubst in_scope pairs = Subst in_scope
                                    (mkVarEnv [(v,co)  | (v, Coercion co) <- pairs])
 
 ------------------------------
-isInScope :: Var -> Subst -> Bool
-isInScope v (Subst in_scope _ _ _) = v `elemInScopeSet` in_scope
-
--- | Add the 'Var' to the in-scope set
-extendSubstInScope :: Subst -> Var -> Subst
-extendSubstInScope (Subst in_scope ids tvs cvs) v
-  = Subst (in_scope `InScopeSet.extendInScopeSet` v)
-          ids tvs cvs
-
--- | Add the 'Var's to the in-scope set: see also 'extendInScope'
-extendSubstInScopeList :: Subst -> [Var] -> Subst
-extendSubstInScopeList (Subst in_scope ids tvs cvs) vs
-  = Subst (in_scope `extendInScopeSetList` vs)
-          ids tvs cvs
-
--- | Add the 'Var's to the in-scope set: see also 'extendInScope'
-extendSubstInScopeSet :: Subst -> VarSet -> Subst
-extendSubstInScopeSet (Subst in_scope ids tvs cvs) vs
-  = Subst (in_scope `extendInScopeSetSet` vs)
-          ids tvs cvs
-
-setInScope :: Subst -> InScopeSet -> Subst
-setInScope (Subst _ ids tvs cvs) in_scope = Subst in_scope ids tvs cvs
-
--- Pretty printing, for debugging only
-
-instance Outputable Subst where
-  ppr (Subst in_scope ids tvs cvs)
-        =  text "<InScope =" <+> in_scope_doc
-        $$ text " IdSubst   =" <+> ppr ids
-        $$ text " TvSubst   =" <+> ppr tvs
-        $$ text " CvSubst   =" <+> ppr cvs
-         <> char '>'
-    where
-    in_scope_doc = pprVarSet (getInScopeVars in_scope) (braces . fsep . map ppr)
 
 {-
 ************************************************************************
@@ -339,14 +240,14 @@ substExprSC subst orig_expr
 -- See Note [Substitutions apply only once] in "GHC.Core.TyCo.Subst"
 --
 -- Do *not* attempt to short-cut in the case of an empty substitution!
--- See Note [Extending the Subst]
+-- See Note [Extending the IdSubstEnv]
 substExpr :: HasDebugCallStack => Subst -> CoreExpr -> CoreExpr
    -- HasDebugCallStack so we can track failures in lookupIdSubst
 substExpr subst expr
   = go expr
   where
     go (Var v)         = lookupIdSubst subst v
-    go (Type ty)       = Type (substTy subst ty)
+    go (Type ty)       = Type (substTyUnchecked subst ty)
     go (Coercion co)   = Coercion (substCo subst co)
     go (Lit lit)       = Lit lit
     go (App fun arg)   = App (go fun) (go arg)
@@ -366,7 +267,7 @@ substExpr subst expr
                        where
                          (subst', bind') = substBind subst bind
 
-    go (Case scrut bndr ty alts) = Case (go scrut) bndr' (substTy subst ty) (map (go_alt subst') alts)
+    go (Case scrut bndr ty alts) = Case (go scrut) bndr' (substTyUnchecked subst ty) (map (go_alt subst') alts)
                                  where
                                  (subst', bndr') = substBndr subst bndr
 
@@ -464,7 +365,7 @@ substIdBndr _doc rec_subst subst@(Subst in_scope env tvs cvs) old_id
   where
     id1 = uniqAway in_scope old_id      -- id1 is cloned if necessary
     id2 | no_type_change = id1
-        | otherwise      = updateIdTypeAndMult (substTy subst) id1
+        | otherwise      = updateIdTypeAndMult (substTyUnchecked subst) id1
 
     old_ty = idType old_id
     old_w = idMult old_id
@@ -484,7 +385,7 @@ substIdBndr _doc rec_subst subst@(Subst in_scope env tvs cvs) old_id
             | otherwise = extendVarEnv env old_id (Var new_id)
 
     no_change = id1 == old_id
-        -- See Note [Extending the Subst]
+        -- See Note [Extending the IdSubstEnv]
         -- it's /not/ necessary to check mb_new_info and no_type_change
 
 {-
@@ -547,41 +448,8 @@ clone_id rec_subst subst@(Subst in_scope idvs tvs cvs) (old_id, uniq)
                 Types and Coercions
 *                                                                      *
 ************************************************************************
-
-For types and coercions we just call the corresponding functions in
-Type and Coercion, but we have to repackage the substitution, from a
-Subst to a TCvSubst.
 -}
 
-substTyVarBndr :: Subst -> TyVar -> (Subst, TyVar)
-substTyVarBndr (Subst in_scope id_env tv_env cv_env) tv
-  = case Type.substTyVarBndr (TCvSubst in_scope tv_env cv_env) tv of
-        (TCvSubst in_scope' tv_env' cv_env', tv')
-           -> (Subst in_scope' id_env tv_env' cv_env', tv')
-
-cloneTyVarBndr :: Subst -> TyVar -> Unique -> (Subst, TyVar)
-cloneTyVarBndr (Subst in_scope id_env tv_env cv_env) tv uniq
-  = case Type.cloneTyVarBndr (TCvSubst in_scope tv_env cv_env) tv uniq of
-        (TCvSubst in_scope' tv_env' cv_env', tv')
-           -> (Subst in_scope' id_env tv_env' cv_env', tv')
-
-substCoVarBndr :: Subst -> CoVar -> (Subst, CoVar)
-substCoVarBndr (Subst in_scope id_env tv_env cv_env) cv
-  = case Coercion.substCoVarBndr (TCvSubst in_scope tv_env cv_env) cv of
-        (TCvSubst in_scope' tv_env' cv_env', cv')
-           -> (Subst in_scope' id_env tv_env' cv_env', cv')
-
--- | See 'GHC.Core.Type.substTy'.
-substTy :: Subst -> Type -> Type
-substTy subst ty = Type.substTyUnchecked (getTCvSubst subst) ty
-
-getTCvSubst :: Subst -> TCvSubst
-getTCvSubst (Subst in_scope _ tenv cenv) = TCvSubst in_scope tenv cenv
-
--- | See 'Coercion.substCo'
-substCo :: HasCallStack => Subst -> Coercion -> Coercion
-substCo subst co = Coercion.substCo (getTCvSubst subst) co
-
 {-
 ************************************************************************
 *                                                                      *
@@ -595,7 +463,7 @@ substIdType subst@(Subst _ _ tv_env cv_env) id
   | (isEmptyVarEnv tv_env && isEmptyVarEnv cv_env)
     || (noFreeVarsOfType old_ty && noFreeVarsOfType old_w) = id
   | otherwise   =
-      updateIdTypeAndMult (substTy subst) id
+      updateIdTypeAndMult (substTyUnchecked subst) id
         -- The tyCoVarsOfType is cheaper than it looks
         -- because we cache the free tyvars of the type
         -- in a Note in the id's type itself