diff options
| -rw-r--r-- | compiler/GHC/Core/Utils.hs | 7 | ||||
| -rw-r--r-- | compiler/GHC/CoreToStg/Prep.hs | 8 |
2 files changed, 13 insertions, 2 deletions
diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs index 6b7eb3bf11..271380557d 100644 --- a/compiler/GHC/Core/Utils.hs +++ b/compiler/GHC/Core/Utils.hs @@ -2460,7 +2460,12 @@ tryEtaReduce bndrs body ok_fun _fun = False --------------- - ok_fun_id fun = fun_arity fun >= incoming_arity + ok_fun_id fun = -- There are arguments to reduce + fun_arity fun >= incoming_arity && + -- We always want args for join points so + -- we should never eta-reduce to a trivial expression. + -- See Note [Invariants on join points] in GHC.Core, and #20599 + not (isJoinId fun) --------------- fun_arity fun -- See Note [Arity care] diff --git a/compiler/GHC/CoreToStg/Prep.hs b/compiler/GHC/CoreToStg/Prep.hs index 675ef7776c..bc12ec2b63 100644 --- a/compiler/GHC/CoreToStg/Prep.hs +++ b/compiler/GHC/CoreToStg/Prep.hs @@ -1527,7 +1527,13 @@ tryEtaReducePrep bndrs expr@(App _ _) ok _ _ = False -- We can't eta reduce something which must be saturated. - ok_to_eta_reduce (Var f) = not (hasNoBinding f) && not (isLinearType (idType f)) + ok_to_eta_reduce (Var f) = not (hasNoBinding f) && + not (isLinearType (idType f)) && -- Unsure why this is unsafe. + (not (isJoinId f) || idJoinArity f <= n_remaining) + -- Don't undersaturate join points. + -- See Note [Invariants on join points] in GHC.Core, and #20599 + + ok_to_eta_reduce _ = False -- Safe. ToDo: generalise |