[Git][ghc/ghc][wip/T22272] Improve the UnfoldingCache mechanism
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Fri Dec 9 07:36:11 UTC 2022
Simon Peyton Jones pushed to branch wip/T22272 at Glasgow Haskell Compiler / GHC
Commits:
60658ec1 by Simon Peyton Jones at 2022-12-09T07:21:39+00:00
Improve the UnfoldingCache mechanism
This small patch adds some documentation around the new UnfoldingCache
field. But most important it does two things:
* In GHC.Core.Unfold.Make.mkCoreUnfolding we we accidentally forcing
the wrong values, which led to duplicate work.
* In GHC.Core.Unfold.callSiteInline we were forcing UnfoldingCache
which caused unnecessary work.
- - - - -
6 changed files:
- compiler/GHC/Core.hs
- compiler/GHC/Core/Seq.hs
- compiler/GHC/Core/Unfold.hs
- compiler/GHC/Core/Unfold/Make.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/IfaceToCore.hs
Changes:
=====================================
compiler/GHC/Core.hs
=====================================
@@ -1299,6 +1299,7 @@ data Unfolding
-- | Properties of a 'CoreUnfolding' that could be computed on-demand from its template.
+-- See Note [UnfoldingCache]
data UnfoldingCache
= UnfoldingCache {
uf_is_value :: !Bool, -- exprIsHNF template (cached); it is ok to discard
@@ -1342,7 +1343,23 @@ data UnfoldingGuidance
| UnfNever -- The RHS is big, so don't inline it
deriving (Eq)
-{-
+{- Note [UnfoldingCache]
+~~~~~~~~~~~~~~~~~~~~~~~~
+The UnfoldingCache field of an Unfolding holds four (strict) booleans,
+all derived from the uf_tmpl field of the unfolding.
+
+* We serialise the UnfoldingCache to and from interface files, for
+ reasons described in Note [Tying the 'CoreUnfolding' knot] in
+ GHC.IfaceToCore
+
+* Because it is a strict data type, we must be careful not to
+ pattern-match on it until we actually want its values. E.g
+ GHC.Core.Unfold.callSiteInline/tryUnfolding are careful not to force
+ it unnecessarily. Just saves a bit of work.
+
+* When `seq`ing Core to eliminate space leaks, to suffices to `seq` on
+ the cache, but not its fields, because it is strict in all fields.
+
Note [Historical note: unfoldings for wrappers]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We used to have a nice clever scheme in interface files for
=====================================
compiler/GHC/Core/Seq.hs
=====================================
@@ -106,6 +106,9 @@ seqUnfolding :: Unfolding -> ()
seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,
uf_cache = cache, uf_guidance = g})
= seqExpr e `seq` top `seq` cache `seq` seqGuidance g
+ -- The unf_cache :: UnfoldingCache field is a strict data type,
+ -- so it is sufficient to use plain `seq` for this field
+ -- See Note [UnfoldingCache] in GHC.Core
seqUnfolding _ = ()
=====================================
compiler/GHC/Core/Unfold.hs
=====================================
@@ -1036,12 +1036,11 @@ callSiteInline logger opts !case_depth id active_unfolding lone_variable arg_inf
-- Things with an INLINE pragma may have an unfolding *and*
-- be a loop breaker (maybe the knot is not yet untied)
CoreUnfolding { uf_tmpl = unf_template
- , uf_cache = UnfoldingCache{ uf_is_work_free = is_wf
- , uf_expandable = is_exp }
+ , uf_cache = unf_cache
, uf_guidance = guidance }
| active_unfolding -> tryUnfolding logger opts case_depth id lone_variable
arg_infos cont_info unf_template
- is_wf is_exp guidance
+ unf_cache guidance
| otherwise -> traceInline logger opts id "Inactive unfolding:" (ppr id) Nothing
NoUnfolding -> Nothing
BootUnfolding -> Nothing
@@ -1163,11 +1162,10 @@ needed on a per-module basis.
-}
tryUnfolding :: Logger -> UnfoldingOpts -> Int -> Id -> Bool -> [ArgSummary] -> CallCtxt
- -> CoreExpr -> Bool -> Bool -> UnfoldingGuidance
+ -> CoreExpr -> UnfoldingCache -> UnfoldingGuidance
-> Maybe CoreExpr
-tryUnfolding logger opts !case_depth id lone_variable
- arg_infos cont_info unf_template
- is_wf is_exp guidance
+tryUnfolding logger opts !case_depth id lone_variable arg_infos
+ cont_info unf_template unf_cache guidance
= case guidance of
UnfNever -> traceInline logger opts id str (text "UnfNever") Nothing
@@ -1179,7 +1177,7 @@ tryUnfolding logger opts !case_depth id lone_variable
-> traceInline logger opts id str (mk_doc some_benefit empty False) Nothing
where
some_benefit = calc_some_benefit uf_arity
- enough_args = (n_val_args >= uf_arity) || (unsat_ok && n_val_args > 0)
+ enough_args = (n_val_args >= uf_arity) || (unsat_ok && n_val_args > 0)
UnfIfGoodArgs { ug_args = arg_discounts, ug_res = res_discount, ug_size = size }
| unfoldingVeryAggressive opts
@@ -1190,9 +1188,6 @@ tryUnfolding logger opts !case_depth id lone_variable
-> traceInline logger opts id str (mk_doc some_benefit extra_doc False) Nothing
where
some_benefit = calc_some_benefit (length arg_discounts)
- extra_doc = vcat [ text "case depth =" <+> int case_depth
- , text "depth based penalty =" <+> int depth_penalty
- , text "discounted size =" <+> int adjusted_size ]
-- See Note [Avoid inlining into deeply nested cases]
depth_treshold = unfoldingCaseThreshold opts
depth_scaling = unfoldingCaseScaling opts
@@ -1202,7 +1197,18 @@ tryUnfolding logger opts !case_depth id lone_variable
small_enough = adjusted_size <= unfoldingUseThreshold opts
discount = computeDiscount arg_discounts res_discount arg_infos cont_info
+ extra_doc = vcat [ text "case depth =" <+> int case_depth
+ , text "depth based penalty =" <+> int depth_penalty
+ , text "discounted size =" <+> int adjusted_size ]
+
where
+ -- Unpack the UnfoldingCache lazily because it may not be needed, and all
+ -- its fields are strict; so evaluating unf_cache at all forces all the
+ -- isWorkFree etc computations to take place. That risks wasting effort for
+ -- Ids that are never going to inline anyway.
+ -- See Note [UnfoldingCache] in GHC.Core
+ UnfoldingCache{ uf_is_work_free = is_wf, uf_expandable = is_exp } = unf_cache
+
mk_doc some_benefit extra_doc yes_or_no
= vcat [ text "arg infos" <+> ppr arg_infos
, text "interesting continuation" <+> ppr cont_info
=====================================
compiler/GHC/Core/Unfold/Make.hs
=====================================
@@ -336,13 +336,10 @@ mkCoreUnfolding :: UnfoldingSource -> Bool -> CoreExpr
-> Maybe UnfoldingCache -> UnfoldingGuidance -> Unfolding
-- Occurrence-analyses the expression before capturing it
mkCoreUnfolding src top_lvl expr precomputed_cache guidance
- = CoreUnfolding { uf_tmpl = is_value `seq`
- is_conlike `seq`
- is_work_free `seq`
- is_expandable `seq`
+ = CoreUnfolding { uf_tmpl = cache `seq`
occurAnalyseExpr expr
-- occAnalyseExpr: see Note [Occurrence analysis of unfoldings]
- -- See #20905 for what a discussion of these 'seq's
+ -- See #20905 for what a discussion of this 'seq'.
-- We are careful to make sure we only
-- have one copy of an unfolding around at once.
-- Note [Thoughtful forcing in mkCoreUnfolding]
=====================================
compiler/GHC/Iface/Syntax.hs
=====================================
@@ -2715,8 +2715,9 @@ instance NFData IfGuidance where
instance NFData IfaceUnfolding where
rnf = \case
- IfCoreUnfold src cache guidance expr -> src `seq` rwhnf cache `seq` rnf guidance `seq` rnf expr
- IfDFunUnfold bndrs exprs -> rnf bndrs `seq` rnf exprs
+ IfCoreUnfold src cache guidance expr -> src `seq` cache `seq` rnf guidance `seq` rnf expr
+ IfDFunUnfold bndrs exprs -> rnf bndrs `seq` rnf exprs
+ -- See Note [UnfoldingCache] in GHC.Core for why it suffices to merely `seq` on cache
instance NFData IfaceExpr where
rnf = \case
=====================================
compiler/GHC/IfaceToCore.hs
=====================================
@@ -1798,7 +1798,6 @@ tcUnfolding _toplvl name dfun_ty _ (IfDFunUnfold bs ops)
{- Note [Tying the 'CoreUnfolding' knot]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
The unfolding of recursive definitions can contain references to the
Id being defined. Consider the following example:
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/60658ec130cf328e937be84f8e4b9a1823cffb18
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/60658ec130cf328e937be84f8e4b9a1823cffb18
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/20221209/c71d1660/attachment-0001.html>
More information about the ghc-commits
mailing list