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

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
Pipeline #13132 canceled with stages
...@@ -1141,6 +1141,7 @@ and now we do NOT want eta expansion to give ...@@ -1141,6 +1141,7 @@ and now we do NOT want eta expansion to give
Instead CoreArity.etaExpand gives Instead CoreArity.etaExpand gives
f = /\a -> \y -> let s = h 3 in g s y f = /\a -> \y -> let s = h 3 in g s y
-} -}
cpeEtaExpand :: Arity -> CpeRhs -> CpeRhs cpeEtaExpand :: Arity -> CpeRhs -> CpeRhs
...@@ -1161,6 +1162,8 @@ get to a partial application: ...@@ -1161,6 +1162,8 @@ get to a partial application:
==> case x of { p -> map f } ==> case x of { p -> map f }
-} -}
-- When updating this function, make sure it lines up with
-- CoreUtils.tryEtaReduce!
tryEtaReducePrep :: [CoreBndr] -> CoreExpr -> Maybe CoreExpr tryEtaReducePrep :: [CoreBndr] -> CoreExpr -> Maybe CoreExpr
tryEtaReducePrep bndrs expr@(App _ _) tryEtaReducePrep bndrs expr@(App _ _)
| ok_to_eta_reduce f | ok_to_eta_reduce f
...@@ -1181,28 +1184,13 @@ tryEtaReducePrep bndrs expr@(App _ _) ...@@ -1181,28 +1184,13 @@ tryEtaReducePrep bndrs expr@(App _ _)
ok _ _ = False ok _ _ = False
-- We can't eta reduce something which must be saturated. -- We can't eta reduce something which must be saturated.
-- This includes binds which have no binding (respond True to ok_to_eta_reduce (Var f) = not (hasNoBinding f)
-- 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 _ = False -- Safe. ToDo: generalise ok_to_eta_reduce _ = False -- Safe. ToDo: generalise
tryEtaReducePrep bndrs (Let bind@(NonRec _ r) body)
| not (any (`elemVarSet` fvs) bndrs) tryEtaReducePrep bndrs (Tick tickish e)
= case tryEtaReducePrep bndrs body of | tickishFloatable tickish
Just e -> Just (Let bind e) = fmap (mkTick tickish) $ tryEtaReducePrep bndrs 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 _ _ = Nothing tryEtaReducePrep _ _ = Nothing
......
...@@ -2379,6 +2379,8 @@ But the simplifier pushes those casts outwards, so we don't ...@@ -2379,6 +2379,8 @@ But the simplifier pushes those casts outwards, so we don't
need to address that here. need to address that here.
-} -}
-- When updating this function, make sure to update
-- CorePrep.tryEtaReducePrep as well!
tryEtaReduce :: [Var] -> CoreExpr -> Maybe CoreExpr tryEtaReduce :: [Var] -> CoreExpr -> Maybe CoreExpr
tryEtaReduce bndrs body tryEtaReduce bndrs body
= go (reverse bndrs) body (mkRepReflCo (exprType 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