From 83361f58746ae08040079a6d809127bca2ae3f4c Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Thu, 5 Nov 2009 17:04:53 +0000 Subject: [PATCH] Be a tiny bit keener to inline in the RHS of a let Seee Note [RHS of lets] in CoreUnfold --- compiler/coreSyn/CoreUnfold.lhs | 34 +++++++++++++++++++++++++--------- compiler/simplCore/SimplUtils.lhs | 12 ++++++++---- compiler/simplCore/Simplify.lhs | 7 +++---- 3 files changed, 36 insertions(+), 17 deletions(-) diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs index d467e89..fa9f5dc 100644 --- a/compiler/coreSyn/CoreUnfold.lhs +++ b/compiler/coreSyn/CoreUnfold.lhs @@ -604,11 +604,13 @@ instance Outputable ArgSummary where data CallCtxt = BoringCtxt - | ArgCtxt Bool -- We're somewhere in the RHS of function with rules - -- => be keener to inline - Int -- We *are* the argument of a function with this arg discount - -- => be keener to inline - -- INVARIANT: ArgCtxt False 0 ==> BoringCtxt + | ArgCtxt -- We are somewhere in the argument of a function + Bool -- True <=> we're somewhere in the RHS of function with rules + -- False <=> we *are* the argument of a function with non-zero + -- arg discount + -- OR + -- we *are* the RHS of a let Note [RHS of lets] + -- In both cases, be a little keener to inline | ValAppCtxt -- We're applied to at least one value arg -- This arises when we have ((f x |> co) y) @@ -618,10 +620,10 @@ data CallCtxt = BoringCtxt -- that decomposes its scrutinee instance Outputable CallCtxt where - ppr BoringCtxt = ptext (sLit "BoringCtxt") - ppr (ArgCtxt rules disc) = ptext (sLit "ArgCtxt") <> ppr (rules,disc) - ppr CaseCtxt = ptext (sLit "CaseCtxt") - ppr ValAppCtxt = ptext (sLit "ValAppCtxt") + 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 active_inline id lone_variable arg_infos cont_info = let @@ -707,6 +709,15 @@ callSiteInline dflags active_inline id lone_variable arg_infos cont_info } \end{code} +Note [RHS of lets] +~~~~~~~~~~~~~~~~~~ +Be a tiny bit keener to inline in the RHS of a let, because that might +lead to good thing later + f y = (y,y,y) + g y = let x = f y in ...(case x of (a,b,c) -> ...) ... +We'd inline 'f' if the call was in a case context, and it kind-of-is, +only we can't see it. So we treat the RHS of a let as not-totally-boring. + Note [Unsaturated applications] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When a call is not saturated, we *still* inline if one of the @@ -806,6 +817,11 @@ At one stage I replaced this condition by 'True' (leading to the above slow-down). The motivation was test eyeball/inline1.hs; but that seems to work ok now. +NOTE: arguably, we should inline in ArgCtxt only if the result of the +call is at least CONLIKE. At least for the cases where we use ArgCtxt +for the RHS of a 'let', we only profit from the inlining if we get a +CONLIKE thing (modulo lets). + Note [Lone variables] ~~~~~~~~~~~~~~~~~~~~~ The "lone-variable" case is important. I spent ages messing about diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs index 56b07c4..e0302a9 100644 --- a/compiler/simplCore/SimplUtils.lhs +++ b/compiler/simplCore/SimplUtils.lhs @@ -16,7 +16,7 @@ module SimplUtils ( SimplCont(..), DupFlag(..), ArgInfo(..), contIsDupable, contResultType, contIsTrivial, contArgs, dropArgs, countValArgs, countArgs, - mkBoringStop, mkLazyArgStop, contIsRhsOrArg, + mkBoringStop, mkRhsStop, mkLazyArgStop, contIsRhsOrArg, interestingCallContext, interestingArg, mkArgInfo, @@ -152,6 +152,9 @@ instance Outputable DupFlag where mkBoringStop :: SimplCont mkBoringStop = Stop BoringCtxt +mkRhsStop :: SimplCont -- See Note [RHS of lets] in CoreUnfold +mkRhsStop = Stop (ArgCtxt False) + mkLazyArgStop :: CallCtxt -> SimplCont mkLazyArgStop cci = Stop cci @@ -260,8 +263,9 @@ interestingCallContext cont where interesting (Select _ bndr _ _ _) | isDeadBinder bndr = CaseCtxt - | otherwise = ArgCtxt False 2 -- If the binder is used, this + | otherwise = ArgCtxt False -- If the binder is used, this -- is like a strict let + -- See Note [RHS of lets] in CoreUnfold interesting (ApplyTo _ arg _ cont) | isTypeArg arg = interesting cont @@ -394,8 +398,8 @@ interestingArgContext rules call_cont go (CoerceIt _ c) = go c go (Stop cci) = interesting cci - interesting (ArgCtxt rules _) = rules - interesting _ = False + interesting (ArgCtxt rules) = rules + interesting _ = False \end{code} diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs index f9cbc0a..6a579db 100644 --- a/compiler/simplCore/Simplify.lhs +++ b/compiler/simplCore/Simplify.lhs @@ -335,8 +335,7 @@ simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se -- See Note [Floating and type abstraction] in SimplUtils -- Simplify the RHS - ; (body_env1, body1) <- simplExprF body_env body mkBoringStop - + ; (body_env1, body1) <- simplExprF body_env body mkRhsStop -- ANF-ise a constructor or PAP rhs ; (body_env2, body2) <- prepareRhs body_env1 body1 @@ -1190,8 +1189,8 @@ rebuildCall env fun ; rebuildCall env (fun `App` arg') arg_info' cont } where arg_info' = ArgInfo { ai_rules = has_rules, ai_strs = strs, ai_discs = discs } - cci | has_rules || disc > 0 = ArgCtxt has_rules disc -- Be keener here - | otherwise = BoringCtxt -- Nothing interesting + cci | has_rules || disc > 0 = ArgCtxt has_rules -- Be keener here + | otherwise = BoringCtxt -- Nothing interesting rebuildCall env fun _ cont = rebuild env fun cont -- 1.7.10.4