[commit: ghc] master: Don't recompute some free vars in lintCoercion (1757dd8)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/1757dd8ebed0732018319e43e6468b868a6aceeb/ghc

>---------------------------------------------------------------

commit 1757dd8ebed0732018319e43e6468b868a6aceeb
Author: Bartosz Nitka <niteria at gmail.com>
Date:   Tue Mar 29 19:37:54 2016 -0700

    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


>---------------------------------------------------------------

1757dd8ebed0732018319e43e6468b868a6aceeb
 compiler/coreSyn/CoreLint.hs | 18 ++++++++++++------
 compiler/types/TyCoRep.hs    |  5 -----
 compiler/types/Type.hs       |  1 -
 3 files changed, 12 insertions(+), 12 deletions(-)

diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs
index bd750a3..ffbd659 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 d6f5516..b1f35da 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 a940200..c5561a3 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,