X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreUnfold.lhs;h=d7ec4c718e7fe79edcfd25a66b5df36ea00ead38;hb=85f8276b368d39c93e137fa7b0a8a96ab3c6b389;hp=4e8e5ef9825a1a953d576027a16e1515e1bce8f2;hpb=112ad1978f8c03d26a7df9ac892915dc93724b66;p=ghc-hetmet.git diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs index 4e8e5ef..d7ec4c7 100644 --- a/compiler/coreSyn/CoreUnfold.lhs +++ b/compiler/coreSyn/CoreUnfold.lhs @@ -536,6 +536,10 @@ data CallCtxt = BoringCtxt -- => be keener to inline -- INVARIANT: ArgCtxt False 0 ==> BoringCtxt + | ValAppCtxt -- We're applied to at least one value arg + -- This arises when we have ((f x |> co) y) + -- Then the (f x) has argument 'x' but in a ValAppCtxt + | CaseCtxt -- We're the scrutinee of a case -- that decomposes its scrutinee @@ -543,6 +547,7 @@ instance Outputable CallCtxt where 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 = case idUnfolding id of { @@ -586,10 +591,13 @@ callSiteInline dflags active_inline id lone_variable arg_infos cont_info -> True | otherwise - -> some_benefit && small_enough + -> 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 @@ -607,8 +615,8 @@ callSiteInline dflags active_inline id lone_variable arg_infos cont_info = 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 - -- See Note [Inlining in ArgCtxt] + 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 @@ -616,7 +624,7 @@ callSiteInline dflags active_inline id lone_variable arg_infos cont_info res_discount' = case cont_info of BoringCtxt -> 0 CaseCtxt -> res_discount - ArgCtxt _ _ -> 4 `min` 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. @@ -652,6 +660,16 @@ branches. Then inlining it doesn't increase allocation, but it does increase the chance that the constructor won't be allocated at all in the branches that don't use it. +Note [Cast then apply] +~~~~~~~~~~~~~~~~~~~~~~ +Consider + myIndex = __inline_me ( (/\a. ) |> co ) + co :: (forall a. a -> a) ~ (forall a. T a) + ... /\a.\x. case ((myIndex a) |> sym co) x of { ... } ... + +We need to inline myIndex to unravel this; but the actual call (myIndex a) has +no value arguments. The ValAppCtxt gives it enough incentive to inline. + Note [Inlining in ArgCtxt] ~~~~~~~~~~~~~~~~~~~~~~~~~~ The condition (n_vals_wanted > 0) here is very important, because otherwise @@ -799,8 +817,9 @@ simpleOptExpr subst expr ---------------------- go_nonrec subst b (Type ty') body | isTyVar b = go (extendTvSubst subst b ty') body + -- let a::* = TYPE ty in go_nonrec subst b r' body - | isId b + | isId b -- let x = e in , exprIsTrivial r' || safe_to_inline (idOccInfo b) = go (extendIdSubst subst b r') body go_nonrec subst b r' body