From 2f97c86151d7eed115ddcbdee1842684aed63176 Mon Sep 17 00:00:00 2001 From: Simon Peyton Jones Date: Tue, 28 Feb 2023 22:43:50 +0000 Subject: Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 --- compiler/GHC/Core/Opt/Arity.hs | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) (limited to 'compiler/GHC/Core') diff --git a/compiler/GHC/Core/Opt/Arity.hs b/compiler/GHC/Core/Opt/Arity.hs index cd0463961e..dfcf1f1ab7 100644 --- a/compiler/GHC/Core/Opt/Arity.hs +++ b/compiler/GHC/Core/Opt/Arity.hs @@ -3105,7 +3105,7 @@ etaExpandToJoinPointRule join_arity rule@(Rule { ru_bndrs = bndrs, ru_rhs = rhs -- Adds as many binders as asked for; assumes expr is not a lambda etaBodyForJoinPoint :: Int -> CoreExpr -> ([CoreBndr], CoreExpr) etaBodyForJoinPoint need_args body - = go need_args (exprType body) (init_subst body) [] body + = go need_args body_ty (mkEmptySubst in_scope) [] body where go 0 _ _ rev_bs e = (reverse rev_bs, e) @@ -3124,9 +3124,16 @@ etaBodyForJoinPoint need_args body = pprPanic "etaBodyForJoinPoint" $ int need_args $$ ppr body $$ ppr (exprType body) - init_subst e = mkEmptySubst (mkInScopeSet (exprFreeVars e)) - - + body_ty = exprType body + in_scope = mkInScopeSet (exprFreeVars body `unionVarSet` tyCoVarsOfType body_ty) + -- in_scope is a bit tricky. + -- - We are wrapping `body` in some value lambdas, so must not shadow + -- any free vars of `body` + -- - We are wrapping `body` in some type lambdas, so must not shadow any + -- tyvars in body_ty. Example: body is just a variable + -- (g :: forall (a::k). T k a -> Int) + -- We must not shadown that `k` when adding the /\a. So treat the free vars + -- of body_ty as in-scope. Showed up in #23026. -------------- freshEtaId :: Int -> Subst -> Scaled Type -> (Subst, Id) -- cgit v1.2.1