Don't recompute some free vars in lintCoercion

As pointed out by @simonpj on D2044 we don't need
to compute the free vars of the range of the substitution
as most of them are already carried by the monad.
This should be a tiny performance improvement over the version
from before D2044.

Also removes an extra function that is now unnecessary.

Test Plan: ./validate && ./validate --slow

Reviewers: goldfire, simonpj, austin, bgamari

Reviewed By: simonpj

Subscribers: thomie, simonmar, simonpj

Differential Revision: https://phabricator.haskell.org/D2060

GHC Trac Issues: #11371

3 files changed, 12 insertions, 12 deletions

diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs
index bd750a346b..ffbd6595da 100644
--- a/compiler/coreSyn/CoreLint.hs
+++ b/compiler/coreSyn/CoreLint.hs
@@ -1290,16 +1290,22 @@ lintCoercion co@(AppCo co1 co2)
 lintCoercion (ForAllCo tv1 kind_co co)
   = do { (_, k2) <- lintStarCoercion kind_co
        ; let tv2 = setTyVarKind tv1 k2
-       ; (k3, k4, t1, t2, r) <- addInScopeVar tv1 $ lintCoercion co
+       ; addInScopeVar tv1 $
+    do {
+       ; (k3, k4, t1, t2, r) <- lintCoercion co
        ; in_scope <- getInScope
        ; let tyl = mkNamedForAllTy tv1 Invisible t1
-             subst = zipTvSubst [tv1] [TyVarTy tv2 `mkCastTy` mkSymCo kind_co]
-                     `extendTCvInScopeInScope` in_scope
-             -- We need free vars of `t2` in scope to satisfy
-             -- Note [The substitution invariant]
+             subst = mkTvSubst in_scope $
+                     -- We need both the free vars of the `t2` and the
+                     -- free vars of the range of the substitution in
+                     -- scope. All the free vars of `t2` and `kind_co` should
+                     -- already be in `in_scope`, because they've been
+                     -- linted and `tv2` has the same unique as `tv1`.
+                     -- See Note [The substitution invariant]
+                     unitVarEnv tv1 (TyVarTy tv2 `mkCastTy` mkSymCo kind_co)
              tyr = mkNamedForAllTy tv2 Invisible $
                    substTy subst t2
-       ; return (k3, k4, tyl, tyr, r) }
+       ; return (k3, k4, tyl, tyr, r) } }
 
 lintCoercion (CoVarCo cv)
   | not (isCoVar cv)
diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs
index d6f551614a..b1f35da311 100644
--- a/compiler/types/TyCoRep.hs
+++ b/compiler/types/TyCoRep.hs
@@ -83,7 +83,6 @@ module TyCoRep (
         getCvSubstEnv, getTCvInScope, isInScope, notElemTCvSubst,
         setTvSubstEnv, setCvSubstEnv, zapTCvSubst,
         extendTCvInScope, extendTCvInScopeList, extendTCvInScopeSet,
-        extendTCvInScopeInScope,
         extendTCvSubst,
         extendCvSubst, extendCvSubstWithClone,
         extendTvSubst, extendTvSubstWithClone,
@@ -1799,10 +1798,6 @@ extendTCvInScopeSet :: TCvSubst -> VarSet -> TCvSubst
 extendTCvInScopeSet (TCvSubst in_scope tenv cenv) vars
   = TCvSubst (extendInScopeSetSet in_scope vars) tenv cenv
 
-extendTCvInScopeInScope :: TCvSubst -> InScopeSet -> TCvSubst
-extendTCvInScopeInScope (TCvSubst in_scope tenv cenv) in_scope'
-  = TCvSubst (unionInScope in_scope in_scope') tenv cenv
-
 extendTCvSubst :: TCvSubst -> TyCoVar -> Type -> TCvSubst
 extendTCvSubst subst v ty
   | isTyVar v
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index a940200f56..c5561a32e6 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -158,7 +158,6 @@ module Type (
         getTvSubstEnv, setTvSubstEnv,
         zapTCvSubst, getTCvInScope,
         extendTCvInScope, extendTCvInScopeList, extendTCvInScopeSet,
-        extendTCvInScopeInScope,
         extendTCvSubst, extendCvSubst,
         extendTvSubst, extendTvSubstList, extendTvSubstAndInScope,
         isInScope, composeTCvSubstEnv, composeTCvSubst, zipTyEnv, zipCoEnv,