Commit 4a1e7e47 authored by Abigail's avatar Abigail Committed by Marge Bot

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
parent de6bbdf2
......@@ -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
......
......@@ -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))
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment