[commit: ghc] wip/T14068: Avoid name capture in setJoinResTy (6a50466)
git at git.haskell.org
git at git.haskell.org
Wed Aug 2 03:07:13 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/T14068
Link : http://ghc.haskell.org/trac/ghc/changeset/6a5046684f93f1870663119b447fff6baeb7a7c4/ghc
>---------------------------------------------------------------
commit 6a5046684f93f1870663119b447fff6baeb7a7c4
Author: Joachim Breitner <mail at joachim-breitner.de>
Date: Tue Aug 1 22:48:26 2017 -0400
Avoid name capture in setJoinResTy
>---------------------------------------------------------------
6a5046684f93f1870663119b447fff6baeb7a7c4
compiler/types/Type.hs | 22 ++++++++++++++++------
1 file changed, 16 insertions(+), 6 deletions(-)
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index 50a35b0..c69d4ff 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -2445,11 +2445,21 @@ setJoinResTy :: Int -- Number of binders to skip
-> Type -- New type
-- INVARIANT: If any of the first n binders are foralls, those tyvars cannot
-- appear in the original result type. See isValidJoinPointType.
+--
+-- When we set the return type under a forall, avoid capture!
setJoinResTy orig_ar new_res_ty orig_ty
- = go orig_ar orig_ty
+ = go init_subst orig_ar orig_ty
where
- go 0 _ = new_res_ty
- go n ty | Just (arg_bndr, res_ty) <- splitPiTy_maybe ty
- = mkPiTy arg_bndr (go (n-1) res_ty)
- | otherwise
- = pprPanic "setJoinResTy" (ppr orig_ar <+> ppr orig_ty)
+ init_subst :: TCvSubst
+ init_subst = mkEmptyTCvSubst (mkInScopeSet (tyCoVarsOfType new_res_ty))
+
+ go _ 0 _ = new_res_ty
+ go subst n ty
+ | Just (t, ty') <- splitForAllTy_maybe ty
+ , let (subst', t') = substTyVarBndr subst t
+ = mkForAllTy t' Inferred (go subst' (n-1) ty')
+ | Just (arg_ty, ty') <- splitFunTy_maybe ty
+ , let arg_ty' = substTy subst arg_ty
+ = mkFunTy arg_ty' (go subst (n-1) ty')
+ | otherwise
+ = pprPanic "setJoinResTy" (ppr orig_ar <+> ppr orig_ty)
More information about the ghc-commits
mailing list