X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcoreSyn%2FCoreUnfold.lhs;h=d57f1886fc0377e7b7d91397a2c169374a9915a2;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=d3c1679e09b22e4ccb3b4bdd7f86d7c86f16fae6;hpb=23f40f0e9be6d4aa5cf9ea31d73f4013f8e7b4bd;p=ghc-hetmet.git diff --git a/ghc/compiler/coreSyn/CoreUnfold.lhs b/ghc/compiler/coreSyn/CoreUnfold.lhs index d3c1679..d57f188 100644 --- a/ghc/compiler/coreSyn/CoreUnfold.lhs +++ b/ghc/compiler/coreSyn/CoreUnfold.lhs @@ -17,30 +17,28 @@ module CoreUnfold ( Unfolding, UnfoldingGuidance, -- Abstract types noUnfolding, mkTopUnfolding, mkUnfolding, mkCompulsoryUnfolding, seqUnfolding, - mkOtherCon, otherCons, + evaldUnfolding, mkOtherCon, otherCons, unfoldingTemplate, maybeUnfoldingTemplate, isEvaldUnfolding, isValueUnfolding, isCheapUnfolding, isCompulsoryUnfolding, hasUnfolding, hasSomeUnfolding, neverUnfold, couldBeSmallEnoughToInline, - certainlyWillInline, + certainlyWillInline, smallEnoughToInline, callSiteInline ) where #include "HsVersions.h" -import CmdLineOpts ( opt_UF_CreationThreshold, - opt_UF_UseThreshold, - opt_UF_FunAppDiscount, - opt_UF_KeenessFactor, +import StaticFlags ( opt_UF_CreationThreshold, opt_UF_UseThreshold, + opt_UF_FunAppDiscount, opt_UF_KeenessFactor, opt_UF_DearOp, - DynFlags, DynFlag(..), dopt ) +import DynFlags ( DynFlags, DynFlag(..), dopt ) import CoreSyn import PprCore ( pprCoreExpr ) -import OccurAnal ( occurAnalyseGlobalExpr ) -import CoreUtils ( exprIsValue, exprIsCheap, exprIsTrivial ) +import OccurAnal ( occurAnalyseExpr ) +import CoreUtils ( exprIsHNF, exprIsCheap, exprIsTrivial ) import Id ( Id, idType, isId, idUnfolding, globalIdDetails ) @@ -53,7 +51,6 @@ import PrelNames ( hasKey, buildIdKey, augmentIdKey ) import Bag import FastTypes import Outputable -import Util #if __GLASGOW_HASKELL__ >= 404 import GLAEXTS ( Int# ) @@ -71,10 +68,10 @@ import GLAEXTS ( Int# ) mkTopUnfolding expr = mkUnfolding True {- Top level -} expr mkUnfolding top_lvl expr - = CoreUnfolding (occurAnalyseGlobalExpr expr) + = CoreUnfolding (occurAnalyseExpr expr) top_lvl - (exprIsValue expr) + (exprIsHNF expr) -- Already evaluated (exprIsCheap expr) @@ -91,7 +88,7 @@ mkUnfolding top_lvl expr -- it gets fixed up next round mkCompulsoryUnfolding expr -- Used for things that absolutely must be unfolded - = CompulsoryUnfolding (occurAnalyseGlobalExpr expr) + = CompulsoryUnfolding (occurAnalyseExpr expr) \end{code} @@ -218,7 +215,6 @@ sizeExpr bOMB_OUT_SIZE top_args expr where rhs_size = foldr (addSize . size_up . snd) sizeZero pairs --- gaw 2004 size_up (Case (Var v) _ _ alts) | v `elem` top_args -- We are scrutinising an argument variable = @@ -243,7 +239,7 @@ sizeExpr bOMB_OUT_SIZE top_args expr -- into h; if we inline f first, while it looks small, then g's -- wrapper will get inlined later anyway. To avoid this nasty -- ordering difference, we make (case a of (x,y) -> ...), - -- *where a is one of the arguments* look free. + -- *where a is one of the arguments* look free. other -> -} @@ -463,6 +459,12 @@ certainlyWillInline (CoreUnfolding _ _ _ is_cheap (UnfoldIfGoodArgs n_vals _ siz = is_cheap && size - (n_vals +1) <= opt_UF_UseThreshold certainlyWillInline other = False + +smallEnoughToInline :: Unfolding -> Bool +smallEnoughToInline (CoreUnfolding _ _ _ _ (UnfoldIfGoodArgs _ _ size _)) + = size <= opt_UF_UseThreshold +smallEnoughToInline other + = False \end{code} %************************************************************************ @@ -523,48 +525,25 @@ callSiteInline dflags active_inline inline_call occ id arg_infos interesting_con | otherwise = case occ of IAmDead -> pprTrace "callSiteInline: dead" (ppr id) False IAmALoopBreaker -> False - OneOcc in_lam one_br -> (not in_lam || is_cheap) && consider_safe in_lam True one_br - NoOccInfo -> is_cheap && consider_safe True False False - - consider_safe in_lam once once_in_one_branch - -- consider_safe decides whether it's a good idea to inline something, - -- given that there's no work-duplication issue (the caller checks that). - -- once_in_one_branch = True means there's a unique textual occurrence + --OneOcc in_lam _ _ -> (not in_lam || is_cheap) && consider_safe True + other -> is_cheap && consider_safe False + -- 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 once + -- consider_safe decides whether it's a good idea to + -- inline something, given that there's no + -- work-duplication issue (the caller checks that). | inline_call = True - | once_in_one_branch - -- Be very keen to inline something if this is its unique occurrence: - -- - -- a) Inlining gives a good chance of eliminating the original - -- binding (and hence the allocation) for the thing. - -- (Provided it's not a top level binding, in which case the - -- allocation costs nothing.) - -- - -- b) Inlining a function that is called only once exposes the - -- body function to the call site. - -- - -- The only time we hold back is when substituting inside a lambda; - -- then if the context is totally uninteresting (not applied, not scrutinised) - -- there is no point in substituting because it might just increase allocation, - -- by allocating the function itself many times - -- Note [Jan 2002]: this comment looks out of date. The actual code - -- doesn't inline *ever* in an uninteresting context. Why not? I - -- think it's just because we don't want to inline top-level constants - -- into uninteresting contexts, lest we (for example) re-nest top-level - -- literal lists. - -- - -- Note: there used to be a '&& not top_level' in the guard above, - -- but that stopped us inlining top-level functions used only once, - -- which is stupid - = WARN( not is_top && not in_lam, ppr id ) - -- If (not in_lam) && one_br then PreInlineUnconditionally - -- should have caught it, shouldn't it? Unless it's a top - -- level thing. - notNull arg_infos || interesting_cont - | otherwise = case guidance of - UnfoldNever -> False ; + UnfoldNever -> False UnfoldIfGoodArgs n_vals_wanted arg_discounts size res_discount | enough_args && size <= (n_vals_wanted + 1) @@ -577,20 +556,25 @@ callSiteInline dflags active_inline inline_call occ id arg_infos interesting_con where some_benefit = or arg_infos || really_interesting_cont || - (not is_top && (once || (n_vals_wanted > 0 && enough_args))) - -- If it occurs more than once, there must be something interesting - -- about some argument, or the result context, to make it worth inlining - -- - -- If a function has a nested defn we also record some-benefit, - -- on the grounds that we are often able to eliminate the binding, - -- and hence the allocation, for the function altogether; this is good - -- for join points. But this only makes sense for *functions*; - -- inlining a constructor doesn't help allocation unless the result is - -- scrutinised. UNLESS the constructor occurs just once, albeit possibly - -- in multiple case 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. - + (not is_top && ({- once || -} (n_vals_wanted > 0 && enough_args))) + -- [was (once && not in_lam)] + -- If it occurs more than once, there must be + -- something interesting about some argument, or the + -- result context, to make it worth inlining + -- + -- If a function has a nested defn we also record + -- some-benefit, on the grounds that we are often able + -- to eliminate the binding, and hence the allocation, + -- for the function altogether; this is good for join + -- points. But this only makes sense for *functions*; + -- inlining a constructor doesn't help allocation + -- unless the result is scrutinised. UNLESS the + -- constructor occurs just once, albeit possibly in + -- multiple case 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. + enough_args = n_val_args >= n_vals_wanted really_interesting_cont | n_val_args < n_vals_wanted = False -- Too few args | n_val_args == n_vals_wanted = interesting_cont @@ -612,10 +596,7 @@ callSiteInline dflags active_inline inline_call occ id arg_infos interesting_con text "is value:" <+> ppr is_value, text "is cheap:" <+> ppr is_cheap, text "guidance" <+> ppr guidance, - text "ANSWER =" <+> if yes_or_no then text "YES" else text "NO", - if yes_or_no then - text "Unfolding =" <+> pprCoreExpr unf_template - else empty]) + text "ANSWER =" <+> if yes_or_no then text "YES" else text "NO"]) result else result @@ -625,8 +606,8 @@ computeDiscount :: Int -> [Int] -> Int -> [Bool] -> Bool -> Int computeDiscount n_vals_wanted arg_discounts res_discount arg_infos result_used -- We multiple the raw discounts (args_discount and result_discount) -- ty opt_UnfoldingKeenessFactor because the former have to do with - -- *size* whereas the discounts imply that there's some extra - -- *efficiency* to be gained (e.g. beta reductions, case reductions) + -- *size* whereas the discounts imply that there's some extra + -- *efficiency* to be gained (e.g. beta reductions, case reductions) -- by inlining. -- we also discount 1 for each argument passed, because these will