diff options
author | Sebastian Graf <sebastian.graf@kit.edu> | 2020-10-07 13:56:08 +0200 |
---|---|---|
committer | Sebastian Graf <sebastian.graf@kit.edu> | 2021-10-05 09:40:46 +0200 |
commit | e11554a3bf26538e5103ffc5d0f99bad2e97397e (patch) | |
tree | 937ddaa39388f2504b30ae43d29687e9b148dd60 | |
parent | a49543a959d75df22e55b643d2c28e6b3de74ebd (diff) | |
download | haskell-wip/T5075.tar.gz |
CprAnal: Activate Sum CPR for local bindingswip/T5075
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
-rw-r--r-- | compiler/GHC/Core/Opt/CprAnal.hs | 76 | ||||
-rw-r--r-- | testsuite/tests/stranal/sigs/T5075.hs | 34 | ||||
-rw-r--r-- | testsuite/tests/stranal/sigs/T5075.stderr | 12 |
3 files changed, 48 insertions, 74 deletions
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 diff --git a/testsuite/tests/stranal/sigs/T5075.hs b/testsuite/tests/stranal/sigs/T5075.hs index c35409aa67..15b1357446 100644 --- a/testsuite/tests/stranal/sigs/T5075.hs +++ b/testsuite/tests/stranal/sigs/T5075.hs @@ -1,11 +1,31 @@ --- | This module currently asserts that we trim CPR for local bindings --- returning a sum. We can hopefully give @loop@ a CPR signature some day, but --- we first have to fix #5075/#16570. +-- | This module currently asserts that we give functions that always return +-- the same constructor of a sum type the CPR property. module T5075 where -- Omission of the type signature is deliberate, otherwise we won't get a join -- point (this is up to the desugarer, not sure why). --- loop :: (Ord a, Num a) => a -> Either a b -loop x = case x < 10 of - True -> Left x - False -> loop (x*2) +-- f :: (Ord a, Num a) => a -> Either a b +f x = case x < 10 of + True -> Left x + False -> f (x*2) + +-- Similarly a join point. Should WW nonetheless +g :: Int -> Int -> Maybe Int +g x y = go x + where + go x = case x < y of + True -> Just x + False -> go (x*2) + +-- Here, go is not a join point, but still should be WW'd for Just. +-- Unfortunately, CPR can't see that (+?) returns Just, so h won't get the CPR +-- property. It probably could by only considering the @Just@ case of the +-- inlined (+?). +h :: Int -> Maybe Int +h x = go x +? go (x+1) + where + Just x +? Just y = Just (x + y) + _ +? _ = Nothing + go z + | z > 10 = Just (x + z) + | otherwise = go (z*2) diff --git a/testsuite/tests/stranal/sigs/T5075.stderr b/testsuite/tests/stranal/sigs/T5075.stderr index e17d5e7c5c..c9625db721 100644 --- a/testsuite/tests/stranal/sigs/T5075.stderr +++ b/testsuite/tests/stranal/sigs/T5075.stderr @@ -1,18 +1,24 @@ ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: <SP(A,A,SCS(C1(L)),A,A,A,A,A)><LP(A,A,LCL(C1(L)),A,A,A,L)><L> +T5075.f: <SP(A,A,SCS(C1(L)),A,A,A,A,A)><LP(A,A,LCL(C1(L)),A,A,A,L)><L> +T5075.g: <1P(L)><SP(L)> +T5075.h: <SP(L)> ==================== Cpr signatures ==================== T5075.$trModule: -T5075.loop: +T5075.f: 1 +T5075.g: 2(1) +T5075.h: ==================== Strictness signatures ==================== T5075.$trModule: -T5075.loop: <1P(A,A,SCS(C1(L)),A,A,A,A,A)><LP(A,A,LCL(C1(L)),A,A,A,L)><L> +T5075.f: <1P(A,A,SCS(C1(L)),A,A,A,A,A)><LP(A,A,LCL(C1(L)),A,A,A,L)><L> +T5075.g: <1P(L)><SP(L)> +T5075.h: <1P(L)> |