From cd1b016f9cec5d206a6f23a97418d900d1801175 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Wed, 7 Oct 2020 13:56:08 +0200 Subject: CprAnal: Activate Sum CPR for local bindings We've had Sum CPR (#5075) for top-level bindings for a couple of years now. That begs the question why we didn't also activate it for local bindings, and the reasons for that are described in `Note [CPR for sum types]`. Only that it didn't make sense! The Note said that Sum CPR would destroy let-no-escapes, but that should be a non-issue since we have syntactic join points in Core now and we don't WW for them (`Note [Don't w/w join points for CPR]`). So I simply activated CPR for all bindings of sum type, thus fixing #5075 and \#16570. NoFib approves: ``` -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- comp_lab_zift -0.0% +0.7% fluid +1.7% +0.7% reptile +0.1% +0.1% -------------------------------------------------------------------------------- Min -0.0% -0.2% Max +1.7% +0.7% Geometric Mean +0.0% +0.0% ``` There were quite a few metric decreases on the order of 1-4%, but T6048 seems to regress significantly, by 26.1%. WW'ing for a `Just` constructor and the nested data type meant additional Simplifier iterations and a 30% increase in term sizes as well as a 200-300% in type sizes due to unboxed 9-tuples. There's not much we can do about it, I'm afraid: We're just doing much more work there. Metric Decrease: T12425 T18698a T18698b T20049 T9020 WWRec Metric Increase: T6048 --- compiler/GHC/Core/Opt/CprAnal.hs | 76 +++++++--------------------------------- 1 file changed, 12 insertions(+), 64 deletions(-) (limited to 'compiler') diff --git a/compiler/GHC/Core/Opt/CprAnal.hs b/compiler/GHC/Core/Opt/CprAnal.hs index b01218d6d7..d3f6a248ce 100644 --- a/compiler/GHC/Core/Opt/CprAnal.hs +++ b/compiler/GHC/Core/Opt/CprAnal.hs @@ -25,14 +25,12 @@ import GHC.Core.DataCon import GHC.Core.FamInstEnv import GHC.Core.Multiplicity import GHC.Core.Opt.WorkWrap.Utils -import GHC.Core.TyCon import GHC.Core.Type -import GHC.Core.Utils ( exprIsHNF, dumpIdInfoOfProgram, normSplitTyConApp_maybe ) +import GHC.Core.Utils import GHC.Core import GHC.Core.Seq import GHC.Data.Graph.UnVar -- for UnVarSet -import GHC.Data.Maybe ( isJust ) import GHC.Utils.Outputable import GHC.Utils.Misc @@ -193,12 +191,12 @@ cprAnalTopBind :: AnalEnv cprAnalTopBind env (NonRec id rhs) = (env', NonRec id' rhs') where - (id', rhs', env') = cprAnalBind TopLevel env id rhs + (id', rhs', env') = cprAnalBind env id rhs cprAnalTopBind env (Rec pairs) = (env', Rec pairs') where - (env', pairs') = cprFix TopLevel env pairs + (env', pairs') = cprFix env pairs -- -- * Analysing expressions @@ -256,13 +254,13 @@ cprAnal' env (Case scrut case_bndr ty alts) cprAnal' env (Let (NonRec id rhs) body) = (body_ty, Let (NonRec id' rhs') body') where - (id', rhs', env') = cprAnalBind NotTopLevel env id rhs + (id', rhs', env') = cprAnalBind env id rhs (body_ty, body') = cprAnal env' body cprAnal' env (Let (Rec pairs) body) = body_ty `seq` (body_ty, Let (Rec pairs') body') where - (env', pairs') = cprFix NotTopLevel env pairs + (env', pairs') = cprFix env pairs (body_ty, body') = cprAnal env' body cprAnalAlt @@ -395,11 +393,10 @@ mAX_CPR_SIZE = 10 -- -- Recursive bindings -cprFix :: TopLevelFlag - -> AnalEnv -- Does not include bindings for this binding +cprFix :: AnalEnv -- Does not include bindings for this binding -> [(Id,CoreExpr)] -> (AnalEnv, [(Id,CoreExpr)]) -- Binders annotated with CPR info -cprFix top_lvl orig_env orig_pairs +cprFix orig_env orig_pairs = loop 1 init_env init_pairs where init_sig id @@ -432,17 +429,16 @@ cprFix top_lvl orig_env orig_pairs where go env (id, rhs) = (env', (id', rhs')) where - (id', rhs', env') = cprAnalBind top_lvl env id rhs + (id', rhs', env') = cprAnalBind env id rhs -- | Process the RHS of the binding for a sensible arity, add the CPR signature -- to the Id, and augment the environment with the signature as well. cprAnalBind - :: TopLevelFlag - -> AnalEnv + :: AnalEnv -> Id -> CoreExpr -> (Id, CoreExpr, AnalEnv) -cprAnalBind top_lvl env id rhs +cprAnalBind env id rhs | isDFunId id -- Never give DFuns the CPR property; we'll never save allocs. = (id, rhs, extendSigEnv env id topCprSig) -- See Note [CPR for data structures] @@ -455,10 +451,8 @@ cprAnalBind top_lvl env id rhs -- possibly trim thunk CPR info rhs_ty' -- See Note [CPR for thunks] - | stays_thunk = trimCprTy rhs_ty - -- See Note [CPR for sum types] - | returns_local_sum = trimCprTy rhs_ty - | otherwise = rhs_ty + | stays_thunk = trimCprTy rhs_ty + | otherwise = rhs_ty -- See Note [Arity trimming for CPR signatures] sig = mkCprSigForArity (idArity id) rhs_ty' id' = setIdCprSig id sig @@ -468,14 +462,6 @@ cprAnalBind top_lvl env id rhs stays_thunk = is_thunk && not_strict is_thunk = not (exprIsHNF rhs) && not (isJoinId id) not_strict = not (isStrUsedDmd (idDemandInfo id)) - -- See Note [CPR for sum types] - (_, ret_ty) = splitPiTys (idType id) - returns_product - | Just (tc, _, _) <- normSplitTyConApp_maybe (ae_fam_envs env) ret_ty - = isJust (tyConSingleAlgDataCon_maybe tc) - | otherwise - = False - returns_local_sum = not (isTopLevel top_lvl) && not returns_product isDataStructure :: Id -> Bool -- See Note [CPR for data structures] @@ -751,44 +737,6 @@ Note that * See Note [CPR examples] -Note [CPR for sum types] -~~~~~~~~~~~~~~~~~~~~~~~~ -Aug 21: This Note is out of date. It says that the subsequent WW split after -CPR for sum types destroys join points, but that is no longer correct; we have -the tools to track join points today and simply don't WW join points, -see Note [Don't w/w join points for CPR]. -Yet the issue persists. It is tracked in #5075 and the ultimate reason is a bit -unclear. All regressions involve CPR'ing functions returning lists, which are -recursive data structures. If we don't CPR them -(due to Note [CPR for recursive data constructors]), we might be able to finally -remove this hack, after doing the proper perf checks. - -Historic Note: - -At the moment we do not do CPR for let-bindings that - * non-top level - * bind a sum type -Reason: I found that in some benchmarks we were losing let-no-escapes, -which messed it all up. Example - let j = \x. .... - in case y of - True -> j False - False -> j True -If we w/w this we get - let j' = \x. .... - in case y of - True -> case j' False of { (# a #) -> Just a } - False -> case j' True of { (# a #) -> Just a } -Notice that j' is not a let-no-escape any more. - -However this means in turn that the *enclosing* function -may be CPR'd (via the returned Justs). But in the case of -sums, there may be Nothing alternatives; and that messes -up the sum-type CPR. - -Conclusion: only do this for products. It's still not -guaranteed OK for products, but sums definitely lose sometimes. - Note [CPR for thunks] ~~~~~~~~~~~~~~~~~~~~~ If the rhs is a thunk, we usually forget the CPR info, because -- cgit v1.2.1