diff options
| -rw-r--r-- | compiler/simplCore/SimplCore.hs | 19 | ||||
| -rw-r--r-- | compiler/simplCore/SimplUtils.hs | 36 |
2 files changed, 22 insertions, 33 deletions
diff --git a/compiler/simplCore/SimplCore.hs b/compiler/simplCore/SimplCore.hs index 0fd929a2a6..38ba186e8a 100644 --- a/compiler/simplCore/SimplCore.hs +++ b/compiler/simplCore/SimplCore.hs @@ -179,9 +179,11 @@ getCoreToDo dflags , sm_names = ["Gentle"] , sm_rules = rules_on -- Note [RULEs enabled in SimplGently] , sm_inline = False - , sm_case_case = False }) - -- Don't do case-of-case transformations. - -- This makes full laziness work better + , sm_case_case = False + -- Don't do case-of-case transformations. + -- This makes full laziness work better + , sm_eta_expand = False}) + -- Note [Do not eta-expand in SimplGently] -- New demand analyser demand_analyser = (CoreDoPasses ([ @@ -946,3 +948,14 @@ transferIdInfo exported_id local_id (specInfo local_info) -- Remember to set the function-name field of the -- rules as we transfer them from one function to another + +-- Note [Do not eta-expand in SimplGently] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- Eta-expansion can seriously blow up the size of the code, if there are +-- newtypes and coercions involved; see #9020 for a particularly good example. +-- +-- It may work out well in a full simplifier phase, when the additional +-- coercions can be optimized away, e.g. after inlining. But the gentle phase +-- does less, in particular no inlining, so chances are high that we will blow +-- up our code for on good reason. diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs index 4c469d111f..777eae2b5b 100644 --- a/compiler/simplCore/SimplUtils.hs +++ b/compiler/simplCore/SimplUtils.hs @@ -1273,7 +1273,7 @@ tryEtaExpandRhs env bndr rhs ; WARN( new_arity < old_id_arity, (ptext (sLit "Arity decrease:") <+> (ppr bndr <+> ppr old_id_arity - <+> ppr old_arity <+> ppr new_arity) $$ ppr new_rhs) ) + <+> ppr old_manifest_arity <+> ppr new_arity) $$ ppr new_rhs) ) -- Note [Arity decrease] in Simplify return (new_arity, new_rhs) } where @@ -1282,17 +1282,17 @@ tryEtaExpandRhs env bndr rhs = return (exprArity rhs, rhs) | sm_eta_expand (getMode env) -- Provided eta-expansion is on - , let new_arity1 = findRhsArity dflags bndr rhs old_arity + , let new_arity1 = findRhsArity dflags bndr rhs old_manifest_arity new_arity2 = idCallArity bndr new_arity = max new_arity1 new_arity2 - , new_arity > old_arity -- And the current manifest arity isn't enough + , new_arity > old_manifest_arity -- And the current manifest arity isn't enough = do { tick (EtaExpansion bndr) ; return (new_arity, etaExpand new_arity rhs) } | otherwise - = return (old_arity, rhs) + = return (old_manifest_arity, rhs) - old_arity = exprArity rhs -- See Note [Do not expand eta-expand PAPs] - old_id_arity = idArity bndr + old_manifest_arity = manifestArity rhs + old_id_arity = idArity bndr {- Note [Eta-expanding at let bindings] @@ -1319,30 +1319,6 @@ because then 'genMap' will inline, and it really shouldn't: at least as far as the programmer is concerned, it's not applied to two arguments! -Note [Do not eta-expand PAPs] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We used to have old_arity = manifestArity rhs, which meant that we -would eta-expand even PAPs. But this gives no particular advantage, -and can lead to a massive blow-up in code size, exhibited by Trac #9020. -Suppose we have a PAP - foo :: IO () - foo = returnIO () -Then we can eta-expand do - foo = (\eta. (returnIO () |> sym g) eta) |> g -where - g :: IO () ~ State# RealWorld -> (# State# RealWorld, () #) - -But there is really no point in doing this, and it generates masses of -coercions and whatnot that eventually disappear again. For T9020, GHC -allocated 6.6G beore, and 0.8G afterwards; and residency dropped from -1.8G to 45M. - -But note that this won't eta-expand, say - f = \g -> map g -Does it matter not eta-expanding such functions? I'm not sure. Perhaps -strictness analysis will have less to bite on? - - ************************************************************************ * * \subsection{Floating lets out of big lambdas} |