[Git][ghc/ghc][wip/T25033] Fix eta-expansion in Prep
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Thu Jul 4 08:12:41 UTC 2024
Simon Peyton Jones pushed to branch wip/T25033 at Glasgow Haskell Compiler / GHC
Commits:
010445e1 by Simon Peyton Jones at 2024-07-04T09:10:28+01: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]
- - - - -
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
=====================================
@@ -1611,7 +1611,7 @@ cpeArgArity env float_decision floats1 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
@@ -1620,15 +1620,15 @@ cpeArgArity env float_decision floats1 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
@@ -1761,7 +1761,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)...)
@@ -1776,15 +1777,22 @@ 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.
+ `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
=====================================
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
=====================================
@@ -527,3 +527,4 @@ test('T24808', [ grep_errmsg(r'myFunction') ], compile, ['-O -ddump-simpl'])
test('T24944', [extra_files(['T24944a.hs'])], multimod_compile, ['T24944', '-v0 -O2'])
test('T24725a', [ grep_errmsg(r'testedRule')], compile, ['-O -ddump-rule-firings'])
+test('T25033', normal, compile, ['-O'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/010445e101bd5d62e3568b15d8c4a0b9fb8b68fb
--
This project does not include diff previews in email notifications.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/010445e101bd5d62e3568b15d8c4a0b9fb8b68fb
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/20240704/0499513c/attachment-0001.html>
More information about the ghc-commits
mailing list