[Git][ghc/ghc][master] Fix eta reduction
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Sep 13 23:22:33 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
6840012e by Simon Peyton Jones at 2023-09-13T19:22:13-04:00
Fix eta reduction
Issue #23922 showed that GHC was bogusly eta-reducing a join point.
We should never eta-reduce (\x -> j x) to j, if j is a join point.
It is extremly difficult to trigger this bug. It took me 45 mins of
trying to make a small tests case, here immortalised as T23922a.
- - - - -
3 changed files:
- compiler/GHC/Core/Opt/Arity.hs
- + testsuite/tests/simplCore/should_compile/T23922a.hs
- testsuite/tests/simplCore/should_compile/all.T
Changes:
=====================================
compiler/GHC/Core/Opt/Arity.hs
=====================================
@@ -2328,18 +2328,6 @@ This test is made by `ok_fun` in tryEtaReduce.
* `/\a. \x. f @(Maybe a) x --> /\a. f @(Maybe a)`
See Note [Do not eta reduce PAPs] for why we insist on a trivial head.
-2. Type and dictionary abstraction. Regardless of whether 'f' is a value, it
- is always sound to reduce /type lambdas/, thus:
- (/\a -> f a) --> f
- Moreover, we always want to, because it makes RULEs apply more often:
- This RULE: `forall g. foldr (build (/\a -> g a))`
- should match `foldr (build (/\b -> ...something complex...))`
- and the simplest way to do so is eta-reduce `/\a -> g a` in the RULE to `g`.
-
- The type checker can insert these eta-expanded versions,
- with both type and dictionary lambdas; hence the slightly
- ad-hoc (all ok_lam bndrs)
-
Of course, eta reduction is not always sound. See Note [Eta reduction soundness]
for when it is.
@@ -2427,6 +2415,25 @@ case where `e` is trivial):
Here it's sound eta-reduce `\x. f x` to `f`, because `f` can't be bottom
after the `seq`. This turned up in #7542.
+ T. If the binders are all type arguments, it's always safe to eta-reduce,
+ regardless of the arity of f.
+ /\a b. f @a @b --> f
+
+2. Type and dictionary abstraction. Regardless of whether 'f' is a value, it
+ is always sound to reduce /type lambdas/, thus:
+ (/\a -> f a) --> f
+ Moreover, we always want to, because it makes RULEs apply more often:
+ This RULE: `forall g. foldr (build (/\a -> g a))`
+ should match `foldr (build (/\b -> ...something complex...))`
+ and the simplest way to do so is eta-reduce `/\a -> g a` in the RULE to `g`.
+
+ More debatably, we extend this to dictionary arguments too, because the type
+ checker can insert these eta-expanded versions, with both type and dictionary
+ lambdas; hence the slightly ad-hoc (all ok_lam bndrs). That is, we eta-reduce
+ \(d::Num a). f d --> f
+ regardless of f's arity. Its not clear whether or not this is important, and
+ it is not in general sound. But that's the way it is right now.
+
And here are a few more technical criteria for when it is *not* sound to
eta-reduce that are specific to Core and GHC:
@@ -2688,20 +2695,25 @@ tryEtaReduce rec_ids bndrs body eval_sd
ok_fun (App fun (Type {})) = ok_fun fun
ok_fun (Cast fun _) = ok_fun fun
ok_fun (Tick _ expr) = ok_fun expr
- ok_fun (Var fun_id) = is_eta_reduction_sound fun_id || all ok_lam bndrs
+ ok_fun (Var fun_id) = is_eta_reduction_sound fun_id
ok_fun _fun = False
---------------
-- See Note [Eta reduction soundness], this is THE place to check soundness!
- is_eta_reduction_sound fun =
- -- Don't eta-reduce in fun in its own recursive RHSs
- not (fun `elemUnVarSet` rec_ids) -- criterion (R)
- -- Check that eta-reduction won't make the program stricter...
- && (fun_arity fun >= incoming_arity -- criterion (A) and (E)
- || all_calls_with_arity incoming_arity) -- criterion (S)
- -- ... and that the function can be eta reduced to arity 0
- -- without violating invariants of Core and GHC
- && not (cantEtaReduceFun fun) -- criteria (L), (J), (W), (B)
+ is_eta_reduction_sound fun
+ | fun `elemUnVarSet` rec_ids -- Criterion (R)
+ = False -- Don't eta-reduce in fun in its own recursive RHSs
+
+ | cantEtaReduceFun fun -- Criteria (L), (J), (W), (B)
+ = False -- Function can't be eta reduced to arity 0
+ -- without violating invariants of Core and GHC
+
+ | otherwise
+ = -- Check that eta-reduction won't make the program stricter...
+ fun_arity fun >= incoming_arity -- Criterion (A) and (E)
+ || all_calls_with_arity incoming_arity -- Criterion (S)
+ || all ok_lam bndrs -- Criterion (T)
+
all_calls_with_arity n = isStrict (fst $ peelManyCalls n eval_sd)
-- See Note [Eta reduction based on evaluation context]
=====================================
testsuite/tests/simplCore/should_compile/T23922a.hs
=====================================
@@ -0,0 +1,19 @@
+{-# OPTIONS_GHC -O -fworker-wrapper-cbv -dcore-lint -Wno-simplifiable-class-constraints #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-- It is very tricky to tickle this bug in 9.6/9.8!
+-- (It came up in a complicated program due to Mikolaj.)
+--
+-- We need a join point, with only dictionary arguments
+-- whose RHS is just another join-point application, which
+-- can be eta-reduced.
+--
+-- The -fworker-wrapper-cbv makes a wrapper whose RHS looks eta-reducible.
+
+module T23922a where
+
+f :: forall a. Eq a => [a] -> Bool
+f x = let {-# NOINLINE j #-}
+ j :: Eq [a] => Bool
+ j = x==x
+ in j
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -499,3 +499,4 @@ test('T23567', [extra_files(['T23567A.hs'])], multimod_compile, ['T23567', '-O -
test('T22404', [only_ways(['optasm']), check_errmsg(r'let') ], compile, ['-ddump-simpl -dsuppress-uniques'])
test('T23864', normal, compile, ['-O -dcore-lint -package ghc -Wno-gadt-mono-local-binds'])
test('T23938', [extra_files(['T23938A.hs'])], multimod_compile, ['T23938', '-O -v0'])
+test('T23922a', normal, compile, ['-O'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6840012e5bb8f5c13e4bf7a4e4cbba0b06420aaa
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6840012e5bb8f5c13e4bf7a4e4cbba0b06420aaa
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/20230913/727d8d11/attachment-0001.html>
More information about the ghc-commits
mailing list