- ppr BoringCtxt = ptext (sLit "BoringCtxt")
- ppr (ArgCtxt _ _) = ptext (sLit "ArgCtxt")
- ppr CaseCtxt = ptext (sLit "CaseCtxt")
- ppr ValAppCtxt = ptext (sLit "ValAppCtxt")
-
-callSiteInline dflags active_inline id lone_variable arg_infos cont_info
- = let
- n_val_args = length arg_infos
- in
- case idUnfolding id of {
- NoUnfolding -> Nothing ;
- OtherCon _ -> Nothing ;
-
- CompulsoryUnfolding unf_template -> Just unf_template ;
- -- CompulsoryUnfolding => there is no top-level binding
- -- for these things, so we must inline it.
- -- Only a couple of primop-like things have
- -- compulsory unfoldings (see MkId.lhs).
- -- We don't allow them to be inactive
-
- InlineRule { uf_tmpl = unf_template, uf_arity = arity, uf_is_top = is_top
- , uf_is_value = is_value, uf_worker = mb_worker }
- -> let yes_or_no | not active_inline = False
- | n_val_args < arity = yes_unsat -- Not enough value args
- | n_val_args == arity = yes_exact -- Exactly saturated
- | otherwise = True -- Over-saturated
- result | yes_or_no = Just unf_template
- | otherwise = Nothing
-
- -- See Note [Inlining an InlineRule]
- is_wrapper = isJust mb_worker
- yes_unsat | is_wrapper = or arg_infos
- | otherwise = False
-
- yes_exact = or arg_infos || interesting_saturated_call
- interesting_saturated_call
- = case cont_info of
- BoringCtxt -> not is_top -- Note [Nested functions]
- CaseCtxt -> not lone_variable || not is_value -- Note [Lone variables]
- ArgCtxt {} -> arity > 0 -- Note [Inlining in ArgCtxt]
- ValAppCtxt -> True -- Note [Cast then apply]
- in
- if dopt Opt_D_dump_inlinings dflags then
- pprTrace ("Considering InlineRule for: " ++ showSDoc (ppr id))
- (vcat [text "active:" <+> ppr active_inline,
- text "arg infos" <+> ppr arg_infos,
- text "interesting call" <+> ppr interesting_saturated_call,
- text "is value:" <+> ppr is_value,
- text "ANSWER =" <+> if yes_or_no then text "YES" else text "NO"])
- result
- else result ;
-
- CoreUnfolding { uf_tmpl = unf_template, uf_is_top = is_top, uf_is_value = is_value,
- uf_is_cheap = is_cheap, uf_guidance = guidance } ->
-
- let
- result | yes_or_no = Just unf_template
- | otherwise = Nothing
-
- yes_or_no = active_inline && is_cheap && consider_safe
- -- We consider even the once-in-one-branch
- -- occurrences, because they won't all have been
- -- caught by preInlineUnconditionally. In particular,
- -- if the occurrence is once inside a lambda, and the
- -- rhs is cheap but not a manifest lambda, then
- -- pre-inline will not have inlined it for fear of
- -- invalidating the occurrence info in the rhs.
-
- consider_safe
- -- consider_safe decides whether it's a good idea to
- -- inline something, given that there's no
- -- work-duplication issue (the caller checks that).
- = case guidance of
- UnfoldNever -> False
- UnfoldIfGoodArgs { ug_arity = n_vals_wanted, ug_args = arg_discounts
- , ug_res = res_discount, ug_size = size }
- | enough_args && size <= (n_vals_wanted + 1)
- -- Inline unconditionally if there no size increase
- -- Size of call is n_vals_wanted (+1 for the function)
- -> True
-
- | otherwise
- -> some_benefit && small_enough && inline_enough_args
-
- where
- enough_args = n_val_args >= n_vals_wanted
- inline_enough_args =
- not (dopt Opt_InlineIfEnoughArgs dflags) || enough_args
-
-
- some_benefit = or arg_infos || really_interesting_cont
- -- There must be something interesting
- -- about some argument, or the result
- -- context, to make it worth inlining
-
- really_interesting_cont
- | n_val_args < n_vals_wanted = False -- Too few args
- | n_val_args == n_vals_wanted = interesting_saturated_call
- | otherwise = True -- Extra args
- -- really_interesting_cont tells if the result of the
- -- call is in an interesting context.
-
- interesting_saturated_call
- = case cont_info of
- BoringCtxt -> not is_top && n_vals_wanted > 0 -- Note [Nested functions]
- CaseCtxt -> not lone_variable || not is_value -- Note [Lone variables]
- ArgCtxt {} -> n_vals_wanted > 0 -- Note [Inlining in ArgCtxt]
- ValAppCtxt -> True -- Note [Cast then apply]
-
- small_enough = (size - discount) <= opt_UF_UseThreshold
- discount = computeDiscount n_vals_wanted arg_discounts
- res_discount' arg_infos
- res_discount' = case cont_info of
- BoringCtxt -> 0
- CaseCtxt -> res_discount
- _other -> 4 `min` res_discount
- -- res_discount can be very large when a function returns
- -- construtors; but we only want to invoke that large discount
- -- when there's a case continuation.
- -- Otherwise we, rather arbitrarily, threshold it. Yuk.
- -- But we want to aovid inlining large functions that return
- -- constructors into contexts that are simply "interesting"
-
- in
- if dopt Opt_D_dump_inlinings dflags then
- pprTrace ("Considering inlining: " ++ showSDoc (ppr id))
- (vcat [text "active:" <+> ppr active_inline,
- text "arg infos" <+> ppr arg_infos,
+ ppr BoringCtxt = ptext (sLit "BoringCtxt")
+ ppr (ArgCtxt rules) = ptext (sLit "ArgCtxt") <+> ppr rules
+ ppr CaseCtxt = ptext (sLit "CaseCtxt")
+ ppr ValAppCtxt = ptext (sLit "ValAppCtxt")
+
+callSiteInline dflags id active_unfolding lone_variable arg_infos cont_info
+ = case idUnfolding id of
+ -- idUnfolding checks for loop-breakers, returning NoUnfolding
+ -- 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_is_top = is_top
+ , uf_is_cheap = is_cheap, uf_arity = uf_arity
+ , uf_guidance = guidance, uf_expandable = is_exp }
+ | active_unfolding -> tryUnfolding dflags id lone_variable
+ arg_infos cont_info unf_template is_top
+ is_cheap is_exp uf_arity guidance
+ | otherwise -> Nothing
+ NoUnfolding -> Nothing
+ OtherCon {} -> Nothing
+ DFunUnfolding {} -> Nothing -- Never unfold a DFun
+
+tryUnfolding :: DynFlags -> Id -> Bool -> [ArgSummary] -> CallCtxt
+ -> CoreExpr -> Bool -> Bool -> Bool -> Arity -> UnfoldingGuidance
+ -> Maybe CoreExpr
+tryUnfolding dflags id lone_variable
+ arg_infos cont_info unf_template is_top
+ is_cheap is_exp uf_arity guidance
+ -- uf_arity will typically be equal to (idArity id),
+ -- but may be less for InlineRules
+ | dopt Opt_D_dump_inlinings dflags && dopt Opt_D_verbose_core2core dflags
+ = pprTrace ("Considering inlining: " ++ showSDoc (ppr id))
+ (vcat [text "arg infos" <+> ppr arg_infos,
+ text "uf arity" <+> ppr uf_arity,