[Git][ghc/ghc][wip/simplifier-tweaks] Deleted 1 commit: Half way attempt at inlining join points
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Mon Jul 17 16:53:44 UTC 2023
Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC
WARNING: The push did not contain any new commits, but force pushed to delete the commits and changes below.
Deleted commits:
be385269 by Simon Peyton Jones at 2023-07-12T17:39:07+01:00
Half way attempt at inlining join points
My idea here is to be more parsimonious about inlining join
points. I was thinking that even
join j x = I# x in
case v of
p1 -> j x1
p2 -> j x2
...
might not inline. Better for consumers.
Also don't inline even in FinalPhase beause we want importing
modules to see this.
- - - - -
4 changed files:
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Unfold.hs
- compiler/GHC/Core/Unfold/Make.hs
- compiler/GHC/IfaceToCore.hs
Changes:
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -43,7 +43,8 @@ import GHC.Core.Opt.Arity ( ArityType, exprArity, arityTypeBotSigs_maybe
, pushCoTyArg, pushCoValArg, exprIsDeadEnd
, typeArity, arityTypeArity, etaExpandAT )
import GHC.Core.SimpleOpt ( exprIsConApp_maybe, joinPointBinding_maybe, joinPointBindings_maybe )
-import GHC.Core.FVs ( mkRuleInfo, exprsFreeIds )
+-- import GHC.Core.FVs ( mkRuleInfo, exprsFreeIds )
+import GHC.Core.FVs ( mkRuleInfo )
import GHC.Core.Rules ( lookupRule, getRules )
import GHC.Core.Multiplicity
@@ -58,12 +59,13 @@ import GHC.Types.Unique ( hasKey )
import GHC.Types.Basic
import GHC.Types.Tickish
import GHC.Types.Var ( isTyCoVar )
-import GHC.Types.Var.Set
+-- import GHC.Types.Var.Set
import GHC.Builtin.PrimOps ( PrimOp (SeqOp) )
import GHC.Builtin.Types.Prim( realWorldStatePrimTy )
import GHC.Builtin.Names( runRWKey )
-import GHC.Data.Maybe ( isNothing, isJust, orElse, mapMaybe )
+-- import GHC.Data.Maybe ( isNothing, isJust, orElse, mapMaybe )
+import GHC.Data.Maybe ( isNothing, orElse, mapMaybe )
import GHC.Data.FastString
import GHC.Unit.Module ( moduleName )
import GHC.Utils.Outputable
@@ -3952,16 +3954,12 @@ mkDupableAlt _env case_bndr jfloats (Alt con alt_bndrs alt_rhs_in)
ok_to_dup_alt :: OutId -> [OutVar] -> OutExpr -> Bool
-- See Note [Duplicating alternatives]
-ok_to_dup_alt case_bndr alt_bndrs alt_rhs
+ok_to_dup_alt _case_bndr _alt_bndrs alt_rhs
| (Var v, args) <- collectArgs alt_rhs
, all exprIsTrivial args
- = if isJust (isDataConId_maybe v)
- then exprsFreeIds args `subVarSet` bndr_set
- else True
+ = isNothing (isDataConId_maybe v)
| otherwise
= False
- where
- bndr_set = mkVarSet (case_bndr : alt_bndrs)
{-
Note [Do not add unfoldings to join points at birth]
@@ -4104,14 +4102,12 @@ To achieve this:
phase. (The Final phase is still quite early, so we might consider
delaying still more.)
-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, /unless/ the join point would be immediately inlined in the
+ following iteration: e.g. if its RHS is trivial.
- It is definitely worth checking for exprIsTrivial, otherwise we get
- an extra Simplifier iteration, because it is inlined in the next
- round.
+ (Previously we used exprIsDupable.) This generates a lot more join points,
+ but makes them much more case-of-case friendly.
3. By the same token we want to use Plan B in
Note [Duplicating StrictArg] when the RHS of the new join point
@@ -4135,7 +4131,7 @@ the join point only when the RHS is
* a constructor application? or
* just non-trivial?
Currently, a bit ad-hoc, but we definitely want to retain the join
-point for data constructors in mkDupableALt (point 2); that is the
+point for data constructors in mkDupableAlt (point 2); that is the
whole point of #19996 described above.
Historical Note [Case binders and join points]
@@ -4424,19 +4420,14 @@ simplLetUnfolding env bind_cxt id new_rhs rhs_ty arity unf
mkLetUnfolding :: UnfoldingOpts -> TopLevelFlag -> UnfoldingSource
-> InId -> OutExpr -> SimplM Unfolding
mkLetUnfolding !uf_opts top_lvl src id new_rhs
- = return (mkUnfolding uf_opts src is_top_lvl is_bottoming new_rhs Nothing)
- -- We make an unfolding *even for loop-breakers*.
- -- Reason: (a) It might be useful to know that they are WHNF
- -- (b) In GHC.Iface.Tidy we currently assume that, if we want to
- -- expose the unfolding then indeed we *have* an unfolding
- -- to expose. (We could instead use the RHS, but currently
- -- we don't.) The simple thing is always to have one.
+ = return (mkCoreUnfolding src is_top_lvl new_rhs Nothing guidance)
where
- -- Might as well force this, profiles indicate up to 0.5MB of thunks
- -- just from this site.
- !is_top_lvl = isTopLevel top_lvl
- -- See Note [Force bottoming field]
- !is_bottoming = isDeadEndId id
+ guidance = calcUnfoldingGuidance uf_opts (isJoinId id) is_top_bottoming new_rhs
+
+ -- Strict binding; profiles indicate up to 0.5MB of thunks
+ -- just from this site. See Note [Force bottoming field]
+ !is_top_lvl = isTopLevel top_lvl
+ !is_top_bottoming =is_top_lvl && isDeadEndId id
-------------------
simplStableUnfolding :: SimplEnv -> BindContext
=====================================
compiler/GHC/Core/Unfold.hs
=====================================
@@ -256,17 +256,18 @@ inlineBoringOk e
calcUnfoldingGuidance
:: UnfoldingOpts
+ -> Bool -- This is a join point
-> Bool -- Definitely a top-level, bottoming binding
-> CoreExpr -- Expression to look at
-> UnfoldingGuidance
-calcUnfoldingGuidance opts is_top_bottoming (Tick t expr)
+calcUnfoldingGuidance opts is_join is_top_bottoming (Tick t expr)
| not (tickishIsCode t) -- non-code ticks don't matter for unfolding
- = calcUnfoldingGuidance opts is_top_bottoming expr
-calcUnfoldingGuidance opts is_top_bottoming expr
+ = calcUnfoldingGuidance opts is_join is_top_bottoming expr
+calcUnfoldingGuidance opts is_join is_top_bottoming expr
= case sizeExpr opts bOMB_OUT_SIZE val_bndrs body of
TooBig -> UnfNever
SizeIs size cased_bndrs scrut_discount
- | uncondInline expr n_val_bndrs size
+ | uncondInline is_join expr n_val_bndrs size
-> UnfWhen { ug_unsat_ok = unSaturatedOk
, ug_boring_ok = boringCxtOk
, ug_arity = n_val_bndrs } -- Note [INLINE for small functions]
@@ -432,11 +433,12 @@ sharing the wrapper closure.
The solution: don’t ignore coercion arguments after all.
-}
-uncondInline :: CoreExpr -> Arity -> Int -> Bool
+uncondInline :: Bool -> CoreExpr -> Arity -> Int -> Bool
-- Inline unconditionally if there no size increase
-- Size of call is arity (+1 for the function)
-- See Note [INLINE for small functions]
-uncondInline rhs arity size
+uncondInline is_join rhs arity size
+ | is_join = size < 10
| arity > 0 = size <= 10 * (arity + 1) -- See Note [INLINE for small functions] (1)
| otherwise = exprIsTrivial rhs -- See Note [INLINE for small functions] (4)
@@ -594,6 +596,7 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr
DataConWorkId dc -> conSize dc (length val_args)
PrimOpId op _ -> primOpSize op (length val_args)
ClassOpId {} -> classOpSize opts top_args val_args
+ JoinId {} -> sizeZero -- See Note [Inlining join points]
_ -> funSize opts top_args fun (length val_args) voids
------------
@@ -685,6 +688,7 @@ callSize n_val_args voids = 10 * (1 + n_val_args - voids)
-- Add 1 for each non-trivial arg;
-- the allocation cost, as in let(rec)
+{-
-- | The size of a jump to a join point
jumpSize
:: Int -- ^ number of value args
@@ -695,6 +699,7 @@ jumpSize n_val_args voids = 2 * (1 + n_val_args - voids)
-- bug #6048, but making them any more expensive loses a 21% improvement in
-- spectral/puzzle. TODO Perhaps adjusting the default threshold would be a
-- better solution?
+-}
funSize :: UnfoldingOpts -> [Id] -> Id -> Int -> Int -> ExprSize
-- Size for functions that are not constructors or primops
@@ -705,9 +710,9 @@ funSize opts top_args fun n_val_args voids
| otherwise = SizeIs size arg_discount res_discount
where
some_val_args = n_val_args > 0
- is_join = isJoinId fun
+-- is_join = isJoinId fun
- size | is_join = jumpSize n_val_args voids
+ size -- | is_join = jumpSize n_val_args voids
| not some_val_args = 0
| otherwise = callSize n_val_args voids
@@ -772,6 +777,21 @@ win", but its terribly dangerous because a function with many many
case branches, each finishing with a constructor, can have an
arbitrarily large discount. This led to terrible code bloat: see #6099.
+Note [Inlining join points]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Suppose we have
+ join j1 a b c d = blah
+ join j2 x = j1 x v x w
+ in ...(jump j2 t)....
+
+Then j1 is just an indirection to j1 with a bit of argument shuffling.
+We want to inline it even though it has more arguments:
+ join j1 a b c d = blah
+ in ...(jump j1 t v t w)...
+
+So we charge nothing for join-point calls; a bit like we make constructor
+applications cheap (see Note [Constructor size and result discount]).
+
Note [Unboxed tuple size and result discount]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
However, unboxed tuples count as size zero. I found occasions where we had
=====================================
compiler/GHC/Core/Unfold/Make.hs
=====================================
@@ -117,7 +117,7 @@ mkWorkerUnfolding opts work_fn
= mkCoreUnfolding src top_lvl new_tmpl Nothing guidance
where
new_tmpl = simpleOptExpr opts (work_fn tmpl)
- guidance = calcUnfoldingGuidance (so_uf_opts opts) False new_tmpl
+ guidance = calcUnfoldingGuidance (so_uf_opts opts) False False new_tmpl
mkWorkerUnfolding _ _ _ = noUnfolding
@@ -328,7 +328,7 @@ mkUnfolding opts src top_lvl is_bottoming expr cache
= mkCoreUnfolding src top_lvl expr cache guidance
where
is_top_bottoming = top_lvl && is_bottoming
- guidance = calcUnfoldingGuidance opts is_top_bottoming expr
+ guidance = calcUnfoldingGuidance opts False is_top_bottoming expr
-- NB: *not* (calcUnfoldingGuidance (occurAnalyseExpr expr))!
-- See Note [Calculate unfolding guidance on the non-occ-anal'd expression]
=====================================
compiler/GHC/IfaceToCore.hs
=====================================
@@ -1778,7 +1778,7 @@ tcUnfolding toplvl name _ info (IfCoreUnfold src cache if_guidance if_expr)
; expr <- tcUnfoldingRhs (isCompulsorySource src) toplvl name if_expr
; let guidance = case if_guidance of
IfWhen arity unsat_ok boring_ok -> UnfWhen arity unsat_ok boring_ok
- IfNoGuidance -> calcUnfoldingGuidance uf_opts is_top_bottoming expr
+ IfNoGuidance -> calcUnfoldingGuidance uf_opts False is_top_bottoming expr
-- See Note [Tying the 'CoreUnfolding' knot]
; return $ mkCoreUnfolding src True expr (Just cache) guidance }
where
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be385269dafbad2d3af3347afac4690b4f9f4933
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be385269dafbad2d3af3347afac4690b4f9f4933
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/20230717/0bdd981f/attachment-0001.html>
More information about the ghc-commits
mailing list