diff options
author | Matheus Magalhães de Alcantara <matheus.de.alcantara@gmail.com> | 2019-11-19 16:39:47 -0300 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-11-23 18:55:23 -0500 |
commit | 4a1e7e47f797fab4165b7cba05edc08d41f5d80e (patch) | |
tree | a7ef654c266a613a1adb3e253ffdc445661d4e78 | |
parent | de6bbdf27f1831818598c7b334cb5b247aa97af7 (diff) | |
download | haskell-4a1e7e47f797fab4165b7cba05edc08d41f5d80e.tar.gz |
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
-rw-r--r-- | compiler/coreSyn/CorePrep.hs | 28 | ||||
-rw-r--r-- | compiler/coreSyn/CoreUtils.hs | 2 |
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)) |