[commit: ghc] master: Fix the in-scope set for extendTvSubstWithClone (15fc528)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/15fc52819c440f9e9b91ce92fcfda3c264cbe1c1/ghc

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

commit 15fc52819c440f9e9b91ce92fcfda3c264cbe1c1
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Sun Jun 12 00:04:30 2016 +0100

    Fix the in-scope set for extendTvSubstWithClone
    
    We'd forgotten the variables free in the kind.
    
    Ditto extendCvSubstWithClone


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

15fc52819c440f9e9b91ce92fcfda3c264cbe1c1
 compiler/typecheck/TcType.hs | 3 +++
 compiler/types/TyCoRep.hs    | 8 ++++++--
 2 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs
index 5a453dd..d6cd5b2 100644
--- a/compiler/typecheck/TcType.hs
+++ b/compiler/typecheck/TcType.hs
@@ -1190,6 +1190,9 @@ mkNakedCastTy :: Type -> Coercion -> Type
 -- for which it's plain stupid to create a cast
 -- This simple function killed off a huge number of Refl casts
 -- in types, at birth.
+-- Note that it's fine to do this even for a "mkNaked" function,
+-- because we don't look at TyCons.  isReflCo checks if the coercion
+-- is structurally Refl; it does not check for shape k ~ k.
 mkNakedCastTy ty co | isReflCo co = ty
 mkNakedCastTy (CastTy ty co1) co2 = CastTy ty (co1 `mkTransCo` co2)
 mkNakedCastTy ty co = CastTy ty co
diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs
index 70d8bba..7df02b6 100644
--- a/compiler/types/TyCoRep.hs
+++ b/compiler/types/TyCoRep.hs
@@ -1829,9 +1829,11 @@ extendTvSubst (TCvSubst in_scope tenv cenv) tv ty
 extendTvSubstWithClone :: TCvSubst -> TyVar -> TyVar -> TCvSubst
 -- Adds a new tv -> tv mapping, /and/ extends the in-scope set
 extendTvSubstWithClone (TCvSubst in_scope tenv cenv) tv tv'
-  = TCvSubst (extendInScopeSet in_scope tv')
+  = TCvSubst (extendInScopeSetSet in_scope new_in_scope)
              (extendVarEnv tenv tv (mkTyVarTy tv'))
              cenv
+  where
+    new_in_scope = tyCoVarsOfType (tyVarKind tv') `extendVarSet` tv'
 
 extendCvSubst :: TCvSubst -> CoVar -> Coercion -> TCvSubst
 extendCvSubst (TCvSubst in_scope tenv cenv) v co
@@ -1839,9 +1841,11 @@ extendCvSubst (TCvSubst in_scope tenv cenv) v co
 
 extendCvSubstWithClone :: TCvSubst -> CoVar -> CoVar -> TCvSubst
 extendCvSubstWithClone (TCvSubst in_scope tenv cenv) cv cv'
-  = TCvSubst (extendInScopeSet in_scope cv')
+  = TCvSubst (extendInScopeSetSet in_scope new_in_scope)
              tenv
              (extendVarEnv cenv cv (mkCoVarCo cv'))
+  where
+    new_in_scope = tyCoVarsOfType (varType cv') `extendVarSet` cv'
 
 extendTvSubstAndInScope :: TCvSubst -> TyVar -> Type -> TCvSubst
 -- Also extends the in-scope set