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,
- okToUnfoldInHiFile,
+ certainlyWillInline, smallEnoughToInline,
callSiteInline
) where
#include "HsVersions.h"
-import CmdLineOpts ( opt_UF_CreationThreshold,
- opt_UF_UseThreshold,
- opt_UF_FunAppDiscount,
- opt_UF_KeenessFactor,
- opt_UF_DearOp, opt_UnfoldCasms,
- DynFlags, DynFlag(..), dopt
+import StaticFlags ( opt_UF_CreationThreshold, opt_UF_UseThreshold,
+ opt_UF_FunAppDiscount, opt_UF_KeenessFactor,
+ opt_UF_DearOp,
)
+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,
- isFCallId_maybe, globalIdDetails
+ idUnfolding, globalIdDetails
)
import DataCon ( isUnboxedTupleCon )
-import Literal ( isLitLitLit, litSize )
+import Literal ( litSize )
import PrimOp ( primOpIsDupable, primOpOutOfLine )
-import ForeignCall ( okToExposeFCall )
import IdInfo ( OccInfo(..), GlobalIdDetails(..) )
import Type ( isUnLiftedType )
import PrelNames ( hasKey, buildIdKey, augmentIdKey )
import Bag
import FastTypes
import Outputable
-import Util
#if __GLASGOW_HASKELL__ >= 404
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)
-- it gets fixed up next round
mkCompulsoryUnfolding expr -- Used for things that absolutely must be unfolded
- = CompulsoryUnfolding (occurAnalyseGlobalExpr expr)
+ = CompulsoryUnfolding (occurAnalyseExpr expr)
\end{code}
| not inline -> UnfoldNever
-- A big function with an INLINE pragma must
-- have an UnfoldIfGoodArgs guidance
- | inline -> UnfoldIfGoodArgs n_val_binders
+ | otherwise -> UnfoldIfGoodArgs n_val_binders
(map (const 0) val_binders)
max_inline_size 0
where
rhs_size = foldr (addSize . size_up . snd) sizeZero pairs
- size_up (Case (Var v) _ alts)
+ size_up (Case (Var v) _ _ alts)
| v `elem` top_args -- We are scrutinising an argument variable
=
{- I'm nuking this special case; BUT see the comment with case alternatives.
-- 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 ->
-}
-- The 1+ is a little discount for reduced allocation in the caller
alts_size tot_size _ = tot_size
-
- size_up (Case e _ alts) = nukeScrutDiscount (size_up e) `addSize`
- foldr (addSize . size_up_alt) sizeZero alts
+-- gaw 2004
+ size_up (Case e _ _ alts) = nukeScrutDiscount (size_up e) `addSize`
+ foldr (addSize . size_up_alt) sizeZero alts
-- We don't charge for the case itself
-- It's a strict thing, and the price of the call
-- is paid by scrut. Also consider
= is_cheap && size - (n_vals +1) <= opt_UF_UseThreshold
certainlyWillInline other
= False
-\end{code}
-
-@okToUnfoldInHifile@ is used when emitting unfolding info into an interface
-file to determine whether an unfolding candidate really should be unfolded.
-The predicate is needed to prevent @_casm_@s (+ lit-lits) from being emitted
-into interface files.
-
-The reason for inlining expressions containing _casm_s into interface files
-is that these fragments of C are likely to mention functions/#defines that
-will be out-of-scope when inlined into another module. This is not an
-unfixable problem for the user (just need to -#include the approp. header
-file), but turning it off seems to the simplest thing to do.
-\begin{code}
-okToUnfoldInHiFile :: CoreExpr -> Bool
-okToUnfoldInHiFile e = opt_UnfoldCasms || go e
- where
- -- Race over an expression looking for CCalls..
- go (Var v) = case isFCallId_maybe v of
- Just fcall -> okToExposeFCall fcall
- Nothing -> True
- go (Lit lit) = not (isLitLitLit lit)
- go (App fun arg) = go fun && go arg
- go (Lam _ body) = go body
- go (Let binds body) = and (map go (body :rhssOfBind binds))
- go (Case scrut bndr alts) = and (map go (scrut:rhssOfAlts alts)) &&
- not (any isLitLitLit [ lit | (LitAlt lit, _, _) <- alts ])
- go (Note _ body) = go body
- go (Type _) = True
+smallEnoughToInline :: Unfolding -> Bool
+smallEnoughToInline (CoreUnfolding _ _ _ _ (UnfoldIfGoodArgs _ _ size _))
+ = size <= opt_UF_UseThreshold
+smallEnoughToInline other
+ = False
\end{code}
-
%************************************************************************
%* *
\subsection{callSiteInline}
| 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)
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
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
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
projects / ghc-hetmet.git / blobdiff