[Git][ghc/ghc][ghc-9.10] Fix eta-expansion in Prep
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Fri Dec 6 16:00:41 UTC 2024
Ben Gamari pushed to branch ghc-9.10 at Glasgow Haskell Compiler / GHC
Commits:
94e008c5 by Simon Peyton Jones at 2024-08-19T09:28:48+02:00
Fix eta-expansion in Prep
As #25033 showed, we were eta-expanding in a way that broke a join point,
which messed up Note [CorePrep invariants].
The fix is rather easy. See Wrinkle (EA1) of
Note [Eta expansion of arguments in CorePrep]
(cherry picked from commit 8bf6fd68001bc1dabdd974506fc735e22e8257a9)
- - - - -
3 changed files:
- compiler/GHC/CoreToStg/Prep.hs
- + testsuite/tests/simplCore/should_compile/T25033.hs
- testsuite/tests/simplCore/should_compile/all.T
Changes:
=====================================
compiler/GHC/CoreToStg/Prep.hs
=====================================
@@ -1548,7 +1548,7 @@ cpeArgArity env float_decision arg
-- See wrinkle (EA2) in Note [Eta expansion of arguments in CorePrep]
| Just ao <- cp_arityOpts (cpe_config env) -- Just <=> -O1 or -O2
- , not (has_join_in_tail_context arg)
+ , not (eta_would_wreck_join arg)
-- See Wrinkle (EA1) of Note [Eta expansion of arguments in CorePrep]
= case exprEtaExpandArity ao arg of
Nothing -> 0
@@ -1557,15 +1557,15 @@ cpeArgArity env float_decision arg
| otherwise
= exprArity arg -- this is cheap enough for -O0
-has_join_in_tail_context :: CoreExpr -> Bool
+eta_would_wreck_join :: CoreExpr -> Bool
-- ^ Identify the cases where we'd generate invalid `CpeApp`s as described in
-- Wrinkle (EA1) of Note [Eta expansion of arguments in CorePrep]
-has_join_in_tail_context (Let bs e) = isJoinBind bs || has_join_in_tail_context e
-has_join_in_tail_context (Lam b e) | isTyVar b = has_join_in_tail_context e
-has_join_in_tail_context (Cast e _) = has_join_in_tail_context e
-has_join_in_tail_context (Tick _ e) = has_join_in_tail_context e
-has_join_in_tail_context (Case _ _ _ alts) = any has_join_in_tail_context (rhssOfAlts alts)
-has_join_in_tail_context _ = False
+eta_would_wreck_join (Let bs e) = isJoinBind bs || eta_would_wreck_join e
+eta_would_wreck_join (Lam _ e) = eta_would_wreck_join e
+eta_would_wreck_join (Cast e _) = eta_would_wreck_join e
+eta_would_wreck_join (Tick _ e) = eta_would_wreck_join e
+eta_would_wreck_join (Case _ _ _ alts) = any eta_would_wreck_join (rhssOfAlts alts)
+eta_would_wreck_join _ = False
maybeSaturate :: Id -> CpeApp -> Int -> [CoreTickish] -> UniqSM CpeRhs
maybeSaturate fn expr n_args unsat_ticks
@@ -1698,7 +1698,8 @@ There is a nasty Wrinkle:
(EA1) When eta expanding an argument headed by a join point, we might get
"crap", as Note [Eta expansion for join points] in GHC.Core.Opt.Arity puts
- it.
+ it. This crap means the output does not conform to the syntax in
+ Note [CorePrep invariants], which then makes later passes crash (#25033).
Consider
f (join j x = rhs in ...(j 1)...(j 2)...)
@@ -1713,16 +1714,23 @@ There is a nasty Wrinkle:
In our case, (join j x = rhs in ...(j 1)...(j 2)...) is not a valid
`CpeApp` (see Note [CorePrep invariants]) and we'd get a crash in the App
case of `coreToStgExpr`.
- Hence we simply check for the cases where an intervening join point
- binding in the tail context of the argument would lead to the introduction
- of such crap via `has_join_in_tail_context`, in which case we abstain from
- eta expansion.
+
+ Hence, in `eta_would_wreck_join`, we check for the cases where an
+ intervening join point binding in the tail context of the argument would
+ make eta-expansion break Note [CorePrep invariants], in which
+ case we abstain from eta expansion.
This scenario occurs rarely; hence it's OK to generate sub-optimal code.
The alternative would be to fix Note [Eta expansion for join points], but
that's quite challenging due to unfoldings of (recursive) join points.
-(EA2) In cpeArgArity, if float_decision = FloatNone) the `arg` will look like
+ `eta_would_wreck_join` sees if there are any join points, like `j` above
+ that would be messed up. It must look inside lambdas (#25033); consider
+ f (\x. join j y = ... in ...(j 1)...(j 3)...)
+ We can't eta expand that `\x` any more than we could if the join was at
+ the top. (And when there's a lambda, we don't have a thunk anyway.)
+
+(EA2) In cpeArgArity, if float_decision=FloatNone the `arg` will look like
let <binds> in rhs
where <binds> is non-empty and can't be floated out of a lazy context (see
`wantFloatLocal`). So we can't eta-expand it anyway, so we can return 0
=====================================
testsuite/tests/simplCore/should_compile/T25033.hs
=====================================
@@ -0,0 +1,18 @@
+{-# OPTIONS_GHC -fno-do-lambda-eta-expansion #-}
+-- It's hard to trigger #25033, because the Simplier eta-expands
+-- lambdas. So I switched off that Simplifier ability, and thereby
+-- triggered the bug on this nice small example.
+
+module T25033 where
+
+{-# NOINLINE woo #-}
+woo x = x
+
+foo v = woo (\xs -> let
+ j ys = \ws -> xs ++ (reverse . reverse . reverse . reverse .
+ reverse . reverse . reverse . reverse) ws
+ in
+ case v of
+ "a" -> j "wim"
+ _ -> j "wam"
+ )
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -516,3 +516,4 @@ test('T24229b', [ grep_errmsg(r'wfoo') ], compile, ['-O2 -ddump-simpl -dno-typea
test('T24370', normal, compile, ['-O'])
test('T24551', normal, compile, ['-O -dcore-lint'])
test('T24726', normal, compile, ['-dcore-lint -dsuppress-uniques'])
+test('T25033', normal, compile, ['-O'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/94e008c5ff66b455c48ededc703942a251e2d52d
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/94e008c5ff66b455c48ededc703942a251e2d52d
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241206/2fc8a100/attachment-0001.html>
More information about the ghc-commits
mailing list