[commit: ghc] master: Fix #11814 by throwing more stuff into InScopeSets (0b6dcf6)
git at git.haskell.org
git at git.haskell.org
Tue Apr 12 12:12:03 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/0b6dcf6d2ccac3b43037650279256022a352de53/ghc
>---------------------------------------------------------------
commit 0b6dcf6d2ccac3b43037650279256022a352de53
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
>---------------------------------------------------------------
0b6dcf6d2ccac3b43037650279256022a352de53
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
More information about the ghc-commits
mailing list