[commit: ghc] ghc-8.0: Fix #11814 by throwing more stuff into InScopeSets (6d1d979)

[git at git.haskell.org]

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

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/6d1d979281c3b2b7e32f6bc50935f5925f89df8b/ghc

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

commit 6d1d979281c3b2b7e32f6bc50935f5925f89df8b
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Wed Apr 6 15:24:34 2016 +0200

    Fix #11814 by throwing more stuff into InScopeSets
    
    (cherry picked from commit 0b6dcf6d2ccac3b43037650279256022a352de53)


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

6d1d979281c3b2b7e32f6bc50935f5925f89df8b
 compiler/stranal/WwLib.hs | 4 +++-
 compiler/types/Type.hs    | 4 ++--
 2 files changed, 5 insertions(+), 3 deletions(-)

diff --git a/compiler/stranal/WwLib.hs b/compiler/stranal/WwLib.hs
index 3d9ab83..1472ead 100644
--- a/compiler/stranal/WwLib.hs
+++ b/compiler/stranal/WwLib.hs
@@ -22,6 +22,7 @@ import MkCore           ( mkRuntimeErrorApp, aBSENT_ERROR_ID, mkCoreUbxTup )
 import MkId             ( voidArgId, voidPrimId )
 import TysPrim          ( voidPrimTy )
 import TysWiredIn       ( tupleDataCon )
+import VarEnv           ( mkInScopeSet )
 import Type
 import Coercion
 import FamInstEnv
@@ -130,7 +131,8 @@ mkWwBodies :: DynFlags
 mkWwBodies dflags fam_envs fun_ty demands res_info one_shots
   = do  { let arg_info = demands `zip` (one_shots ++ repeat NoOneShotInfo)
               all_one_shots = foldr (worstOneShot . snd) OneShotLam arg_info
-        ; (wrap_args, wrap_fn_args, work_fn_args, res_ty) <- mkWWargs emptyTCvSubst fun_ty arg_info
+              empty_subst = mkEmptyTCvSubst (mkInScopeSet (tyCoVarsOfType fun_ty))
+        ; (wrap_args, wrap_fn_args, work_fn_args, res_ty) <- mkWWargs empty_subst fun_ty arg_info
         ; (useful1, work_args, wrap_fn_str, work_fn_str) <- mkWWstr dflags fam_envs wrap_args
 
         -- Do CPR w/w.  See Note [Always do CPR w/w]
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index 7b5922f..7cf13e3 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -1079,9 +1079,9 @@ mkCastTy ty co | isReflexiveCo co = ty
 
 mkCastTy (CastTy ty co1) co2 = mkCastTy ty (co1 `mkTransCo` co2)
 -- See Note [Weird typing rule for ForAllTy]
-mkCastTy (ForAllTy (Named tv vis) inner_ty) co
+mkCastTy outer_ty@(ForAllTy (Named tv vis) inner_ty) co
   = -- have to make sure that pushing the co in doesn't capture the bound var
-    let fvs = tyCoVarsOfCo co
+    let fvs = tyCoVarsOfCo co `unionVarSet` tyCoVarsOfType outer_ty
         empty_subst = mkEmptyTCvSubst (mkInScopeSet fvs)
         (subst, tv') = substTyVarBndr empty_subst tv
     in