[Git][ghc/ghc][wip/simplifier-tweaks] 2 commits: Don't create a trivial join point
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Thu Jul 27 14:36:22 UTC 2023
Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC
Commits:
66f436c7 by Simon Peyton Jones at 2023-07-27T14:50:33+01:00
Don't create a trivial join point
- - - - -
0c32ab92 by Simon Peyton Jones at 2023-07-27T15:33:02+01:00
Two changes...
* Simplify the too_many_occs thing in simplLetUnfolding
It was preventing a jolly good unfolding of a join point in T15304
join j x = case x of R y -> y
in ...lots of calls to j (R v)....
* Backtrack on making postInlineUnconditionally more agressive.
It made T19695 worse (in compile time anyway).
- && ( (n_br == 1) -- One syntactic occurrence
- -- See Note [Post-inline for single-use things]
+ && ( (n_br == 1 && not_inside_lam) -- One syntactic occurrence
+ -- See Note [Post-inline for single-use things]
- - - - -
2 changed files:
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
Changes:
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -3754,7 +3754,8 @@ mkDupableContWithDmds env _
, sc_fun_ty = fun_ty })
-- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable
| isNothing (isDataConId_maybe (ai_fun fun))
- , thumbsUpPlanA cont -- See point (3) of Note [Duplicating join points]
+ -- isDataConId: see point (3) of Note [Duplicating join points]
+ , thumbsUpPlanA cont
= -- Use Plan A of Note [Duplicating StrictArg]
-- pprTrace "Using plan A" (ppr (ai_fun fun) $$ text "args" <+> ppr (ai_args fun) $$ text "cont" <+> ppr cont) $
do { let (_ : dmds) = ai_dmds fun
@@ -3955,12 +3956,20 @@ mkDupableAlt _env case_bndr jfloats (Alt con alt_bndrs alt_rhs_in)
ok_to_dup_alt :: OutId -> [OutVar] -> OutExpr -> Bool
-- See Note [Duplicating alternatives]
+-- and Note [Duplicating join point] esp point (2)
ok_to_dup_alt case_bndr alt_bndrs alt_rhs
+ | exprIsTrivial alt_rhs
+ = True -- Includes things like (case x of {})
+
| (Var v, args) <- collectArgs alt_rhs
, all exprIsTrivial args
= if isJust (isDataConId_maybe v)
- then exprsFreeIds args `subVarSet` bndr_set
- else True
+ then -- See Note [Duplicating join points] for the
+ -- reason for this apparently strange test
+ exprsFreeIds args `subVarSet` bndr_set
+ else True -- Duplicating a simple call (f a b c) is fine,
+ -- (especially if f is itself a join point).
+
| otherwise
= False
where
@@ -4075,7 +4084,7 @@ See #4957 a fuller example.
Note [Duplicating join points]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-IN #19996 we discovered that we want to be really careful about
+In #19996 we discovered that we want to be really careful about
inlining join points. Consider
case (join $j x = K f x )
(in case v of )
@@ -4110,10 +4119,15 @@ To achieve this:
postInlineUnconditionally is primarily to push allocation into cold
branches; but a join point doesn't allocate, so that's a non-motivation.
-2. In mkDupableAlt and mkDupableStrictBind, generate an alterative for
- all alternatives, except for exprIsTrival RHSs. Previously we used
- exprIsDupable. This generates a lot more join points, but makes
- them much more case-of-case friendly.
+2. In mkDupableAlt and mkDupableStrictBind, generate an alterative for all
+ alternatives, except for exprIsTrival RHSs (see `ok_to_dup_alt`). Previously
+ we used exprIsDupable. This generates a lot more join points, but makes them
+ much more case-of-case friendly.
+
+ We are happy to duplicate
+ j a b = K b a
+ where all the arguments of the constructor are parameters of the join point
+ because then the "massive difference" described above can't happen.
It is definitely worth checking for exprIsTrivial, otherwise we get
an extra Simplifier iteration, because it is inlined in the next
@@ -4121,7 +4135,10 @@ To achieve this:
3. By the same token we want to use Plan B in
Note [Duplicating StrictArg] when the RHS of the new join point
- is a data constructor application. That same Note explains why we
+ is a data constructor application. See the call to isDataConId in
+ the StrictArg case of mkDupableContWithDmds.
+
+ That same Note [Duplicating StrictArg] explains why we sometimes
want Plan A when the RHS of the new join point would be a
non-data-constructor application
@@ -4409,8 +4426,7 @@ simplLetUnfolding env bind_cxt id new_rhs rhs_ty arity unf
= -- See Note [Do not inline exit join points] in GHC.Core.Opt.Exitify
return noUnfolding
- | isJoinId id
- , too_many_occs (idOccInfo id)
+ | freshly_born_join_point id
= -- This is a tricky one!
-- See wrinkle (JU1) in Note [Do not add unfoldings to join points at birth]
return noUnfolding
@@ -4421,10 +4437,8 @@ simplLetUnfolding env bind_cxt id new_rhs rhs_ty arity unf
in mkLetUnfolding opts (bindContextLevel bind_cxt) VanillaSrc id new_rhs
where
- too_many_occs (ManyOccs {}) = True
- too_many_occs (OneOcc { occ_n_br = n }) = n > 10 -- See #23627
- too_many_occs IAmDead = False
- too_many_occs (IAmALoopBreaker {}) = False
+ freshly_born_join_point id = isJoinId id && isManyOccs (idOccInfo id)
+ -- OLD: too_many_occs (OneOcc { occ_n_br = n }) = n > 10 -- See #23627
-------------------
mkLetUnfolding :: UnfoldingOpts -> TopLevelFlag -> UnfoldingSource
=====================================
compiler/GHC/Core/Opt/Simplify/Utils.hs
=====================================
@@ -1547,8 +1547,8 @@ postInlineUnconditionally env bind_cxt old_bndr bndr rhs
| let not_inside_lam = in_lam == NotInsideLam
-> n_br < 100 -- See #23627
- && ( (n_br == 1) -- One syntactic occurrence
- -- See Note [Post-inline for single-use things]
+ && ( (n_br == 1 && not_inside_lam) -- One syntactic occurrence
+ -- See Note [Post-inline for single-use things]
|| (is_lazy && smallEnoughToInline uf_opts unfolding))
-- Multiple syntactic occurences; but lazy, and small enough to dup
-- ToDo: consider discount on smallEnoughToInline if int_cxt is true
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b8ed299073bc7149f868d1c6c0c95e45ac26d038...0c32ab928f154cadeb80dfdbe9d3b3b4ae13bed7
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b8ed299073bc7149f868d1c6c0c95e45ac26d038...0c32ab928f154cadeb80dfdbe9d3b3b4ae13bed7
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230727/785be84f/attachment-0001.html>
More information about the ghc-commits
mailing list