diff options
Diffstat (limited to 'compiler/GHC/Core/Unfold/Make.hs')
| -rw-r--r-- | compiler/GHC/Core/Unfold/Make.hs | 59 |
1 files changed, 35 insertions, 24 deletions
diff --git a/compiler/GHC/Core/Unfold/Make.hs b/compiler/GHC/Core/Unfold/Make.hs index adbbdec763..479187005b 100644 --- a/compiler/GHC/Core/Unfold/Make.hs +++ b/compiler/GHC/Core/Unfold/Make.hs @@ -6,6 +6,7 @@ module GHC.Core.Unfold.Make , mkUnfolding , mkCoreUnfolding , mkFinalUnfolding + , mkFinalUnfolding' , mkSimpleUnfolding , mkWorkerUnfolding , mkInlineUnfoldingWithArity, mkInlineUnfoldingNoArity @@ -35,6 +36,8 @@ import GHC.Utils.Outputable import GHC.Utils.Misc import GHC.Utils.Panic +import Data.Maybe ( fromMaybe ) + -- the very simple optimiser is used to optimise unfoldings import {-# SOURCE #-} GHC.Core.SimpleOpt @@ -43,7 +46,14 @@ import {-# SOURCE #-} GHC.Core.SimpleOpt mkFinalUnfolding :: UnfoldingOpts -> UnfoldingSource -> DmdSig -> CoreExpr -> Unfolding -- "Final" in the sense that this is a GlobalId that will not be further -- simplified; so the unfolding should be occurrence-analysed -mkFinalUnfolding opts src strict_sig expr +mkFinalUnfolding opts src strict_sig expr = mkFinalUnfolding' opts src strict_sig expr Nothing + +-- See Note [Tying the 'CoreUnfolding' knot] for why interfaces need +-- to pass a precomputed 'UnfoldingCache' +mkFinalUnfolding' :: UnfoldingOpts -> UnfoldingSource -> DmdSig -> CoreExpr -> Maybe UnfoldingCache -> Unfolding +-- "Final" in the sense that this is a GlobalId that will not be further +-- simplified; so the unfolding should be occurrence-analysed +mkFinalUnfolding' opts src strict_sig expr = mkUnfolding opts src True {- Top level -} (isDeadEndSig strict_sig) @@ -57,7 +67,7 @@ mkCompulsoryUnfolding' opts expr = mkCompulsoryUnfolding (simpleOptExpr opts exp mkCompulsoryUnfolding :: CoreExpr -> Unfolding mkCompulsoryUnfolding expr = mkCoreUnfolding CompulsorySrc True - expr + expr Nothing (UnfWhen { ug_arity = 0 -- Arity of unfolding doesn't matter , ug_unsat_ok = unSaturatedOk, ug_boring_ok = boringCxtOk }) @@ -69,7 +79,7 @@ mkCompulsoryUnfolding expr mkSimpleUnfolding :: UnfoldingOpts -> CoreExpr -> Unfolding mkSimpleUnfolding !opts rhs - = mkUnfolding opts VanillaSrc False False rhs + = mkUnfolding opts VanillaSrc False False rhs Nothing mkDFunUnfolding :: [Var] -> DataCon -> [CoreExpr] -> Unfolding mkDFunUnfolding bndrs con ops @@ -81,7 +91,7 @@ mkDFunUnfolding bndrs con ops mkDataConUnfolding :: CoreExpr -> Unfolding -- Used for non-newtype data constructors with non-trivial wrappers mkDataConUnfolding expr - = mkCoreUnfolding StableSystemSrc True expr guide + = mkCoreUnfolding StableSystemSrc True expr Nothing guide -- No need to simplify the expression where guide = UnfWhen { ug_arity = manifestArity expr @@ -93,7 +103,7 @@ mkWrapperUnfolding :: SimpleOpts -> CoreExpr -> Arity -> Unfolding -- after demand/CPR analysis mkWrapperUnfolding opts expr arity = mkCoreUnfolding StableSystemSrc True - (simpleOptExpr opts expr) + (simpleOptExpr opts expr) Nothing (UnfWhen { ug_arity = arity , ug_unsat_ok = unSaturatedOk , ug_boring_ok = boringCxtNotOk }) @@ -104,7 +114,7 @@ mkWorkerUnfolding opts work_fn (CoreUnfolding { uf_src = src, uf_tmpl = tmpl , uf_is_top = top_lvl }) | isStableSource src - = mkCoreUnfolding src top_lvl new_tmpl guidance + = 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 @@ -119,7 +129,7 @@ mkInlineUnfoldingNoArity :: SimpleOpts -> UnfoldingSource -> CoreExpr -> Unfoldi mkInlineUnfoldingNoArity opts src expr = mkCoreUnfolding src True -- Note [Top-level flag on inline rules] - expr' guide + expr' Nothing guide where expr' = simpleOptExpr opts expr guide = UnfWhen { ug_arity = manifestArity expr' @@ -133,7 +143,7 @@ mkInlineUnfoldingWithArity :: SimpleOpts -> UnfoldingSource -> Arity -> CoreExpr mkInlineUnfoldingWithArity opts src arity expr = mkCoreUnfolding src True -- Note [Top-level flag on inline rules] - expr' guide + expr' Nothing guide where expr' = simpleOptExpr opts expr guide = UnfWhen { ug_arity = arity @@ -146,7 +156,7 @@ mkInlineUnfoldingWithArity opts src arity expr mkInlinableUnfolding :: SimpleOpts -> UnfoldingSource -> CoreExpr -> Unfolding mkInlinableUnfolding opts src expr - = mkUnfolding (so_uf_opts opts) src False False expr' + = mkUnfolding (so_uf_opts opts) src False False expr' Nothing where expr' = simpleOptExpr opts expr @@ -180,7 +190,7 @@ specUnfolding opts spec_bndrs spec_app rule_lhs_args , uf_guidance = old_guidance }) | isStableSource src -- See Note [Specialising unfoldings] , UnfWhen { ug_arity = old_arity } <- old_guidance - = mkCoreUnfolding src top_lvl new_tmpl + = mkCoreUnfolding src top_lvl new_tmpl Nothing (old_guidance { ug_arity = old_arity - arity_decrease }) where new_tmpl = simpleOptExpr opts $ @@ -310,11 +320,12 @@ mkUnfolding :: UnfoldingOpts -> Bool -- Definitely a bottoming binding -- (only relevant for top-level bindings) -> CoreExpr + -> Maybe UnfoldingCache -> Unfolding -- Calculates unfolding guidance -- Occurrence-analyses the expression before capturing it -mkUnfolding opts src top_lvl is_bottoming expr - = mkCoreUnfolding src top_lvl expr guidance +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 @@ -322,26 +333,20 @@ mkUnfolding opts src top_lvl is_bottoming expr -- See Note [Calculate unfolding guidance on the non-occ-anal'd expression] mkCoreUnfolding :: UnfoldingSource -> Bool -> CoreExpr - -> UnfoldingGuidance -> Unfolding + -> Maybe UnfoldingCache -> UnfoldingGuidance -> Unfolding -- Occurrence-analyses the expression before capturing it -mkCoreUnfolding src top_lvl expr guidance - = CoreUnfolding { uf_tmpl = is_value `seq` - is_conlike `seq` - is_work_free `seq` - is_expandable `seq` +mkCoreUnfolding src top_lvl expr precomputed_cache guidance + = 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] , uf_src = src , uf_is_top = top_lvl - , uf_is_value = is_value - , uf_is_conlike = is_conlike - , uf_is_work_free = is_work_free - , uf_expandable = is_expandable + , uf_cache = cache , uf_guidance = guidance } where is_value = exprIsHNF expr @@ -349,6 +354,13 @@ mkCoreUnfolding src top_lvl expr guidance is_work_free = exprIsWorkFree expr is_expandable = exprIsExpandable expr + recomputed_cache = UnfoldingCache { uf_is_value = is_value + , uf_is_conlike = is_conlike + , uf_is_work_free = is_work_free + , uf_expandable = is_expandable } + + cache = fromMaybe recomputed_cache precomputed_cache + ---------------- certainlyWillInline :: UnfoldingOpts -> IdInfo -> CoreExpr -> Maybe Unfolding -- ^ Sees if the unfolding is pretty certain to inline. @@ -476,4 +488,3 @@ reducing memory pressure. The result of fixing this led to a 1G reduction in peak memory usage (12G -> 11G) when compiling a very large module (peak 3 million terms). For more discussion see #20905. -} - |