[commit: ghc] master: Fix ASSERT failure in tc269 (b1317a3)

[git at git.haskell.org]

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

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

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

commit b1317a35770b19838c7f6b07e794bfc61419e889
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Jul 27 14:47:07 2017 +0100

    Fix ASSERT failure in tc269
    
    This ASSERT failure (in substTy) was reported in Trac #14024.
    
    This patch gets the in-scope set right.
    
    (Does not fix tests T13822 or T13594.)


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

b1317a35770b19838c7f6b07e794bfc61419e889
 compiler/typecheck/TcCanonical.hs | 9 +++------
 1 file changed, 3 insertions(+), 6 deletions(-)

diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs
index 48c1bec..7b25925 100644
--- a/compiler/typecheck/TcCanonical.hs
+++ b/compiler/typecheck/TcCanonical.hs
@@ -24,7 +24,6 @@ import FamInstEnv ( FamInstEnvs )
 import FamInst ( tcTopNormaliseNewTypeTF_maybe )
 import Var
 import VarEnv( mkInScopeSet )
-import VarSet
 import Outputable
 import DynFlags( DynFlags )
 import NameSet
@@ -644,8 +643,7 @@ can_eq_nc_forall :: CtEvidence -> EqRel
 
 can_eq_nc_forall ev eq_rel s1 s2
  | CtWanted { ctev_loc = loc, ctev_dest = orig_dest } <- ev
- = do { let free_tvs1 = tyCoVarsOfType s1
-            free_tvs2 = tyCoVarsOfType s2
+ = do { let free_tvs       = tyCoVarsOfTypes [s1,s2]
             (bndrs1, phi1) = tcSplitForAllTyVarBndrs s1
             (bndrs2, phi2) = tcSplitForAllTyVarBndrs s2
       ; if not (equalLength bndrs1 bndrs2)
@@ -656,7 +654,7 @@ can_eq_nc_forall ev eq_rel s1 s2
                 ; canEqHardFailure ev s1 s2 }
         else
    do { traceTcS "Creating implication for polytype equality" $ ppr ev
-      ; let empty_subst1 = mkEmptyTCvSubst $ mkInScopeSet free_tvs1
+      ; let empty_subst1 = mkEmptyTCvSubst $ mkInScopeSet free_tvs
       ; (subst1, skol_tvs) <- tcInstSkolTyVarsX empty_subst1 $
                               binderVars bndrs1
 
@@ -682,8 +680,7 @@ can_eq_nc_forall ev eq_rel s1 s2
 
             go _ _ _ = panic "cna_eq_nc_forall"  -- case (s:ss) []
 
-            empty_subst2 = mkEmptyTCvSubst $ mkInScopeSet $
-                           free_tvs2 `unionVarSet` closeOverKinds (mkVarSet skol_tvs)
+            empty_subst2 = mkEmptyTCvSubst (getTCvInScope subst1)
 
       ; (implic, _ev_binds, all_co) <- buildImplication skol_info skol_tvs [] $
                                        go skol_tvs empty_subst2 bndrs2