Make CorePrep.tryEtaReducePrep and CoreUtils.tryEtaReduce line up

Simon PJ says he prefers this fix to #17429 over banning eta-reduction
for jumps entirely. Sure enough, this also works.

Test case: simplCore/should_compile/T17429.hs

(cherry picked from commit 4a1e7e47f797fab4165b7cba05edc08d41f5d80e)

2 files changed, 10 insertions, 20 deletions

diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs
index 771163d562..4a5891a013 100644
--- a/compiler/coreSyn/CorePrep.hs
+++ b/compiler/coreSyn/CorePrep.hs
@@ -1141,6 +1141,7 @@ and now we do NOT want eta expansion to give
 
 Instead CoreArity.etaExpand gives
                 f = /\a -> \y -> let s = h 3 in g s y
+
 -}
 
 cpeEtaExpand :: Arity -> CpeRhs -> CpeRhs
@@ -1161,6 +1162,8 @@ get to a partial application:
     ==> case x of { p -> map f }
 -}
 
+-- When updating this function, make sure it lines up with
+-- CoreUtils.tryEtaReduce!
 tryEtaReducePrep :: [CoreBndr] -> CoreExpr -> Maybe CoreExpr
 tryEtaReducePrep bndrs expr@(App _ _)
   | ok_to_eta_reduce f
@@ -1181,28 +1184,13 @@ tryEtaReducePrep bndrs expr@(App _ _)
     ok _    _         = False
 
     -- We can't eta reduce something which must be saturated.
-    -- This includes binds which have no binding (respond True to
-    -- hasNoBinding) and join points (responds True to isJoinId)
-    -- Eta-reducing join points led to #17429.
-    ok_to_eta_reduce (Var f) =
-      not (isJoinId f) && not (hasNoBinding f)
+    ok_to_eta_reduce (Var f) = not (hasNoBinding f)
     ok_to_eta_reduce _       = False -- Safe. ToDo: generalise
 
-tryEtaReducePrep bndrs (Let bind@(NonRec _ r) body)
-  | not (any (`elemVarSet` fvs) bndrs)
-  = case tryEtaReducePrep bndrs body of
-        Just e -> Just (Let bind e)
-        Nothing -> Nothing
-  where
-    fvs = exprFreeVars r
-
--- NB: do not attempt to eta-reduce across ticks
--- Otherwise we risk reducing
---       \x. (Tick (Breakpoint {x}) f x)
---   ==> Tick (breakpoint {x}) f
--- which is bogus (#17228)
--- tryEtaReducePrep bndrs (Tick tickish e)
---   = fmap (mkTick tickish) $ tryEtaReducePrep bndrs e
+
+tryEtaReducePrep bndrs (Tick tickish e)
+  | tickishFloatable tickish
+  = fmap (mkTick tickish) $ tryEtaReducePrep bndrs e
 
 tryEtaReducePrep _ _ = Nothing
 
diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs
index 1ca5a6b438..16f4a00341 100644
--- a/compiler/coreSyn/CoreUtils.hs
+++ b/compiler/coreSyn/CoreUtils.hs
@@ -2379,6 +2379,8 @@ But the simplifier pushes those casts outwards, so we don't
 need to address that here.
 -}
 
+-- When updating this function, make sure to update
+-- CorePrep.tryEtaReducePrep as well!
 tryEtaReduce :: [Var] -> CoreExpr -> Maybe CoreExpr
 tryEtaReduce bndrs body
   = go (reverse bndrs) body (mkRepReflCo (exprType body))