couldBeSmallEnoughToInline,
certainlyWillInline,
- okToUnfoldInHiFile,
callSiteInline
) where
opt_UF_UseThreshold,
opt_UF_FunAppDiscount,
opt_UF_KeenessFactor,
- opt_UF_DearOp, opt_UnfoldCasms,
+ opt_UF_DearOp,
DynFlags, DynFlag(..), dopt
)
import CoreSyn
import OccurAnal ( occurAnalyseGlobalExpr )
import CoreUtils ( exprIsValue, 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 ( fromInt )
+import GLAEXTS ( Int# )
#endif
\end{code}
-- but no more.
in
- case (sizeExpr bOMB_OUT_SIZE val_binders body) of
+ case (sizeExpr (iUnbox bOMB_OUT_SIZE) val_binders body) of
TooBig
| 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
\end{code}
\begin{code}
-sizeExpr :: Int -- Bomb out if it gets bigger than this
+sizeExpr :: Int# -- Bomb out if it gets bigger than this
-> [Id] -- Arguments; we're interested in which of these
-- get case'd
-> CoreExpr
| fun `hasKey` augmentIdKey = augmentSize
| otherwise
= case globalIdDetails fun of
- DataConId dc -> conSizeN dc (valArgCount args)
+ DataConWorkId dc -> conSizeN dc (valArgCount args)
FCallId fc -> sizeN opt_UF_DearOp
PrimOpId op -> primOpSize op (valArgCount args)
-- These addSize things have to be here because
-- I don't want to give them bOMB_OUT_SIZE as an argument
- addSizeN TooBig _ = TooBig
- addSizeN (SizeIs n xs d) m
- | n_tot ># (iUnbox bOMB_OUT_SIZE) = TooBig
- | otherwise = SizeIs n_tot xs d
- where
- n_tot = n +# iUnbox m
+ addSizeN TooBig _ = TooBig
+ addSizeN (SizeIs n xs d) m = mkSizeIs bOMB_OUT_SIZE (n +# iUnbox m) xs d
- addSize TooBig _ = TooBig
- addSize _ TooBig = TooBig
- addSize (SizeIs n1 xs d1) (SizeIs n2 ys d2)
- | n_tot ># (iUnbox bOMB_OUT_SIZE) = TooBig
- | otherwise = SizeIs n_tot xys d_tot
- where
- n_tot = n1 +# n2
- d_tot = d1 +# d2
- xys = xs `unionBags` ys
+ addSize TooBig _ = TooBig
+ addSize _ TooBig = TooBig
+ addSize (SizeIs n1 xs d1) (SizeIs n2 ys d2)
+ = mkSizeIs bOMB_OUT_SIZE (n1 +# n2) (xs `unionBags` ys) (d1 +# d2)
\end{code}
Code for manipulating sizes
\begin{code}
-
data ExprSize = TooBig
| SizeIs FastInt -- Size found
(Bag (Id,Int)) -- Arguments cased herein, and discount for each such
FastInt -- Size to subtract if result is scrutinised
-- by a case expression
-
+-- subtract the discount before deciding whether to bale out. eg. we
+-- want to inline a large constructor application into a selector:
+-- tup = (a_1, ..., a_99)
+-- x = case tup of ...
+--
+mkSizeIs max n xs d | (n -# d) ># max = TooBig
+ | otherwise = SizeIs n xs d
+
maxSize TooBig _ = TooBig
maxSize _ TooBig = TooBig
maxSize s1@(SizeIs n1 _ _) s2@(SizeIs n2 _ _) | n1 ># n2 = s1
UnfoldNever -> False
other -> True
-certainlyWillInline :: Id -> Bool
- -- Sees if the Id is pretty certain to inline
-certainlyWillInline v
- = case idUnfolding v of
-
- CoreUnfolding _ _ _ is_cheap g@(UnfoldIfGoodArgs n_vals _ size _)
- -> is_cheap
- && size - (n_vals +1) <= opt_UF_UseThreshold
-
- other -> False
+certainlyWillInline :: Unfolding -> Bool
+ -- Sees if the unfolding is pretty certain to inline
+certainlyWillInline (CoreUnfolding _ _ _ is_cheap (UnfoldIfGoodArgs n_vals _ size _))
+ = 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
-\end{code}
-
-
%************************************************************************
%* *
\subsection{callSiteInline}
-- 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,
-- If (not in_lam) && one_br then PreInlineUnconditionally
-- should have caught it, shouldn't it? Unless it's a top
-- level thing.
- not (null arg_infos) || interesting_cont
+ notNull arg_infos || interesting_cont
| otherwise
= case guidance of
-- Discount of 1 for each arg supplied, because the
-- result replaces the call
round (opt_UF_KeenessFactor *
- fromInt (arg_discount + result_discount))
+ fromIntegral (arg_discount + result_discount))
where
arg_discount = sum (zipWith mk_arg_discount arg_discounts arg_infos)
projects / ghc-hetmet.git / blobdiff