[commit: ghc] wip/rae: Fix #11814 by throwing more stuff into InScopeSets (35d882a)

[git at git.haskell.org]

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

On branch  : wip/rae
Link       : http://ghc.haskell.org/trac/ghc/changeset/35d882a416d1f172b32ea9c6fed1074d5c48b4b9/ghc

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

commit 35d882a416d1f172b32ea9c6fed1074d5c48b4b9
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


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

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

diff --git a/compiler/stranal/WwLib.hs b/compiler/stranal/WwLib.hs
index 7c85036..4ec36ba 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
@@ -127,7 +128,9 @@ mkWwBodies :: DynFlags
 --                        E
 
 mkWwBodies dflags fam_envs fun_ty demands res_info
-  = do  { (wrap_args, wrap_fn_args, work_fn_args, res_ty) <- mkWWargs emptyTCvSubst fun_ty demands
+  = do  { let empty_subst = mkEmptyTCvSubst (mkInScopeSet (tyCoVarsOfType fun_ty))
+
+        ; (wrap_args, wrap_fn_args, work_fn_args, res_ty) <- mkWWargs empty_subst fun_ty demands
         ; (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 c5561a3..8901968 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -1084,9 +1084,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