diff options
| author | Matthew Pickering <matthewtpickering@gmail.com> | 2021-06-09 09:00:50 +0100 |
|---|---|---|
| committer | Matthew Pickering <matthewtpickering@gmail.com> | 2021-06-09 09:02:58 +0100 |
| commit | 01513b78ae683248e21471623b62b75a5e1304c9 (patch) | |
| tree | ac299fcf4e082ba1b7e60964fe32b5c9fa193a91 /compiler/GHC/Core/Opt/Simplify.hs | |
| parent | 9e724f6e5bcb31abd270ea44fb01b1edb18f626f (diff) | |
| download | haskell-wip/t19478.tar.gz | |
eta: Be more careful not to eta-expand a PAPwip/t19478
This change was originally in !4900 but has been extract to test to see
if it fixes #19478
Diffstat (limited to 'compiler/GHC/Core/Opt/Simplify.hs')
| -rw-r--r-- | compiler/GHC/Core/Opt/Simplify.hs | 13 |
1 files changed, 7 insertions, 6 deletions
diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs index 19705f5541..c3e391a328 100644 --- a/compiler/GHC/Core/Opt/Simplify.hs +++ b/compiler/GHC/Core/Opt/Simplify.hs @@ -50,7 +50,7 @@ import GHC.Core.Unfold.Make import GHC.Core.Utils import GHC.Core.Opt.Arity ( ArityType(..) , pushCoTyArg, pushCoValArg - , idArityType, etaExpandAT ) + , idArityType, etaExpandAT, exprArity, arityTypeArity ) import GHC.Core.SimpleOpt ( exprIsConApp_maybe, joinPointBinding_maybe, joinPointBindings_maybe ) import GHC.Core.FVs ( mkRuleInfo ) import GHC.Core.Rules ( lookupRule, getRules, initRuleOpts ) @@ -3942,11 +3942,12 @@ simplStableUnfolding env top_lvl mb_cont id rhs_ty id_arity unf -- See Note [Simplifying inside stable unfoldings] in GHC.Core.Opt.Simplify.Utils -- See Note [Eta-expand stable unfoldings] - eta_expand expr - | not eta_on = expr - | exprIsTrivial expr = expr - | otherwise = etaExpandAT id_arity expr - eta_on = sm_eta_expand (getMode env) + eta_expand expr | sm_eta_expand (getMode env) + , exprArity expr < arityTypeArity id_arity + , wantEtaExpansion expr + = etaExpandAT id_arity expr + | otherwise + = expr {- Note [Eta-expand stable unfoldings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |