\begin{code}
module CoreUnfold (
- Unfolding(..), UnfoldingGuidance, -- types
+ Unfolding, UnfoldingGuidance, -- types
- noUnfolding, mkUnfolding, getUnfoldingTemplate,
- isEvaldUnfolding, hasUnfolding,
+ noUnfolding, mkTopUnfolding, mkUnfolding, mkCompulsoryUnfolding, seqUnfolding,
+ mkOtherCon, otherCons,
+ unfoldingTemplate, maybeUnfoldingTemplate,
+ isEvaldUnfolding, isCheapUnfolding,
+ hasUnfolding, hasSomeUnfolding,
couldBeSmallEnoughToInline,
certainlySmallEnoughToInline,
okToUnfoldInHiFile,
- calcUnfoldingGuidance,
+ calcUnfoldingGuidance,
callSiteInline, blackListed
) where
import PprCore ( pprCoreExpr )
import OccurAnal ( occurAnalyseGlobalExpr )
import BinderInfo ( )
-import CoreUtils ( coreExprType, exprIsTrivial, mkFormSummary, whnfOrBottom,
- FormSummary(..) )
-import Id ( Id, idType, idUnique, isId,
+import CoreUtils ( coreExprType, exprIsTrivial, exprIsValue, exprIsCheap )
+import Id ( Id, idType, idUnique, isId, getIdWorkerInfo,
getIdSpecialisation, getInlinePragma, getIdUnfolding
)
import VarSet
+import Name ( isLocallyDefined )
import Const ( Con(..), isLitLitLit, isWHNFCon )
import PrimOp ( PrimOp(..), primOpIsDupable )
-import IdInfo ( ArityInfo(..), InlinePragInfo(..), OccInfo(..) )
+import IdInfo ( ArityInfo(..), InlinePragInfo(..), OccInfo(..), insideLam, workerExists )
import TyCon ( tyConFamilySize )
-import Type ( splitAlgTyConApp_maybe, splitFunTy_maybe )
+import Type ( splitAlgTyConApp_maybe, splitFunTy_maybe, isUnLiftedType )
import Const ( isNoRepLit )
-import Unique ( Unique, buildIdKey, augmentIdKey, runSTRepIdKey )
+import Unique ( Unique, buildIdKey, augmentIdKey )
import Maybes ( maybeToBool )
import Bag
import Util ( isIn, lengthExceeds )
import Outputable
+
+#if __GLASGOW_HASKELL__ >= 404
+import GlaExts ( fromInt )
+#endif
\end{code}
%************************************************************************
-- case x of { C f -> ... }
-- Here, f gets an OtherCon [] unfolding.
+ | CompulsoryUnfolding CoreExpr -- There is no "original" definition,
+ -- so you'd better unfold.
+
| CoreUnfolding -- An unfolding with redundant cached information
- FormSummary -- Tells whether the template is a WHNF or bottom
- UnfoldingGuidance -- Tells about the *size* of the template.
CoreExpr -- Template; binder-info is correct
+ Bool -- This is a top-level binding
+ Bool -- exprIsCheap template (cached); it won't duplicate (much) work
+ -- if you inline this in more than one place
+ Bool -- exprIsValue template (cached); it is ok to discard a `seq` on
+ -- this variable
+ UnfoldingGuidance -- Tells about the *size* of the template.
+
+seqUnfolding :: Unfolding -> ()
+seqUnfolding (CoreUnfolding e top b1 b2 g)
+ = seqExpr e `seq` top `seq` b1 `seq` b2 `seq` seqGuidance g
+seqUnfolding other = ()
\end{code}
\begin{code}
noUnfolding = NoUnfolding
+mkOtherCon = OtherCon
-mkUnfolding expr
- = let
- -- strictness mangling (depends on there being no CSE)
- ufg = calcUnfoldingGuidance opt_UF_CreationThreshold expr
- occ = occurAnalyseGlobalExpr expr
- in
- CoreUnfolding (mkFormSummary expr) ufg occ
+mkTopUnfolding expr = mkUnfolding True expr
+
+mkUnfolding top_lvl expr
+ = CoreUnfolding (occurAnalyseGlobalExpr expr)
+ top_lvl
+ (exprIsCheap expr)
+ (exprIsValue expr)
+ (calcUnfoldingGuidance opt_UF_CreationThreshold expr)
+
+mkCompulsoryUnfolding expr -- Used for things that absolutely must be unfolded
+ = CompulsoryUnfolding (occurAnalyseGlobalExpr expr)
-getUnfoldingTemplate :: Unfolding -> CoreExpr
-getUnfoldingTemplate (CoreUnfolding _ _ expr) = expr
-getUnfoldingTemplate other = panic "getUnfoldingTemplate"
+unfoldingTemplate :: Unfolding -> CoreExpr
+unfoldingTemplate (CoreUnfolding expr _ _ _ _) = expr
+unfoldingTemplate (CompulsoryUnfolding expr) = expr
+unfoldingTemplate other = panic "getUnfoldingTemplate"
+
+maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
+maybeUnfoldingTemplate (CoreUnfolding expr _ _ _ _) = Just expr
+maybeUnfoldingTemplate (CompulsoryUnfolding expr) = Just expr
+maybeUnfoldingTemplate other = Nothing
+
+otherCons (OtherCon cons) = cons
+otherCons other = []
isEvaldUnfolding :: Unfolding -> Bool
isEvaldUnfolding (OtherCon _) = True
-isEvaldUnfolding (CoreUnfolding ValueForm _ expr) = True
+isEvaldUnfolding (CoreUnfolding _ _ _ is_evald _) = is_evald
isEvaldUnfolding other = False
+isCheapUnfolding :: Unfolding -> Bool
+isCheapUnfolding (CoreUnfolding _ _ is_cheap _ _) = is_cheap
+isCheapUnfolding other = False
+
hasUnfolding :: Unfolding -> Bool
-hasUnfolding NoUnfolding = False
-hasUnfolding other = True
+hasUnfolding (CoreUnfolding _ _ _ _ _) = True
+hasUnfolding (CompulsoryUnfolding _) = True
+hasUnfolding other = False
+
+hasSomeUnfolding :: Unfolding -> Bool
+hasSomeUnfolding NoUnfolding = False
+hasSomeUnfolding other = True
data UnfoldingGuidance
= UnfoldNever
- | UnfoldAlways -- There is no "original" definition,
- -- so you'd better unfold. Or: something
- -- so cheap to unfold (e.g., 1#) that
- -- you should do it absolutely always.
-
| UnfoldIfGoodArgs Int -- and "n" value args
[Int] -- Discount if the argument is evaluated.
Int -- Scrutinee discount: the discount to substract if the thing is in
-- a context (case (thing args) of ...),
-- (where there are the right number of arguments.)
+
+seqGuidance (UnfoldIfGoodArgs n ns a b) = n `seq` sum ns `seq` a `seq` b `seq` ()
+seqGuidance other = ()
\end{code}
\begin{code}
instance Outputable UnfoldingGuidance where
- ppr UnfoldAlways = ptext SLIT("ALWAYS")
ppr UnfoldNever = ptext SLIT("NEVER")
ppr (UnfoldIfGoodArgs v cs size discount)
- = hsep [ptext SLIT("IF_ARGS"), int v,
- if null cs -- always print *something*
- then char 'X'
- else hcat (map (text . show) cs),
+ = hsep [ ptext SLIT("IF_ARGS"), int v,
+ brackets (hsep (map int cs)),
int size,
int discount ]
\end{code}
-> CoreExpr -- expression to look at
-> UnfoldingGuidance
calcUnfoldingGuidance bOMB_OUT_SIZE expr
- | exprIsTrivial expr -- Often trivial expressions are never bound
- -- to an expression, but it can happen. For
- -- example, the Id for a nullary constructor has
- -- a trivial expression as its unfolding, and
- -- we want to make sure that we always unfold it.
- = UnfoldAlways
-
- | otherwise
- = case collectBinders expr of { (binders, body) ->
+ = case collect_val_bndrs expr of { (inline, val_binders, body) ->
let
- val_binders = filter isId binders
+ n_val_binders = length val_binders
in
case (sizeExpr bOMB_OUT_SIZE val_binders body) of
- TooBig -> UnfoldNever
+ TooBig
+ | not inline -> UnfoldNever
+ -- A big function with an INLINE pragma must
+ -- have an UnfoldIfGoodArgs guidance
+ | inline -> UnfoldIfGoodArgs n_val_binders
+ (map (const 0) val_binders)
+ (n_val_binders + 2) 0
+ -- See comments with final_size below
SizeIs size cased_args scrut_discount
-> UnfoldIfGoodArgs
- (length val_binders)
+ n_val_binders
(map discount_for val_binders)
- (I# size)
+ final_size
(I# scrut_discount)
where
+ boxed_size = I# size
+
+ final_size | inline = 0 -- Trying very agresssive inlining of INLINE things.
+ -- Reason: we don't want to call the un-inlined version,
+ -- because its body is awful
+ -- boxed_size `min` (n_val_binders + 2) -- Trying "+2" again...
+ | otherwise = boxed_size
+ -- The idea is that if there is an INLINE pragma (inline is True)
+ -- and there's a big body, we give a size of n_val_binders+1. This
+ -- This is enough to pass the no-size-increase test in callSiteInline,
+ -- but no more.
+ -- I tried n_val_binders+2, to just defeat the test, on the grounds that
+ -- we don't want to inline an INLINE thing into a totally boring context,
+ -- but I found that some wrappers (notably one for a join point) weren't
+ -- getting inlined, and that was terrible. In that particular case, the
+ -- call site applied the wrapper to realWorld#, so if we made that an
+ -- "interesting" value the inlining would have happened... but it was
+ -- simpler to inline wrappers a little more eagerly instead.
+ --
+ -- Sometimes, though, an INLINE thing is smaller than n_val_binders+2.
+ -- A particular case in point is a constructor, which has size 1.
+ -- We want to inline this regardless, hence the `min`
+
discount_for b
| num_cases == 0 = 0
| is_fun_ty = num_cases * opt_UF_FunAppDiscount
- | is_data_ty = num_cases * tyConFamilySize tycon * opt_UF_ScrutConDiscount
+ | is_data_ty = num_cases * opt_UF_ScrutConDiscount
| otherwise = num_cases * opt_UF_PrimArgDiscount
where
num_cases = foldlBag (\n b' -> if b==b' then n+1 else n) 0 cased_args
Nothing -> (False, panic "discount")
Just (tc,_,_) -> (True, tc)
}
+ where
+
+ collect_val_bndrs e = go False [] e
+ -- We need to be a bit careful about how we collect the
+ -- value binders. In ptic, if we see
+ -- __inline_me (\x y -> e)
+ -- We want to say "2 value binders". Why? So that
+ -- we take account of information given for the arguments
+
+ go inline rev_vbs (Note InlineMe e) = go True rev_vbs e
+ go inline rev_vbs (Lam b e) | isId b = go inline (b:rev_vbs) e
+ | otherwise = go inline rev_vbs e
+ go inline rev_vbs e = (inline, reverse rev_vbs, e)
\end{code}
\begin{code}
size_up (Type t) = sizeZero -- Types cost nothing
size_up (Var v) = sizeOne
- size_up (Note InlineMe _) = sizeTwo -- The idea is that this is one more
- -- than the size of the "call" (i.e. 1)
- -- We want to reply "no" to noSizeIncrease
- -- for a bare reference (i.e. applied to no args)
- -- to an INLINE thing
-
size_up (Note _ body) = size_up body -- Notes cost nothing
size_up (App fun (Type t)) = size_up fun
size_up (Let (NonRec binder rhs) body)
= nukeScrutDiscount (size_up rhs) `addSize`
size_up body `addSizeN`
- 1 -- For the allocation
+ (if isUnLiftedType (idType binder) then 0 else 1)
+ -- For the allocation
+ -- If the binder has an unlifted type there is no allocation
size_up (Let (Rec pairs) body)
= nukeScrutDiscount rhs_size `addSize`
size_up (Case scrut _ alts)
= nukeScrutDiscount (size_up scrut) `addSize`
arg_discount scrut `addSize`
- foldr (addSize . size_up_alt) sizeZero alts `addSizeN`
- case (splitAlgTyConApp_maybe (coreExprType scrut)) of
- Nothing -> 1
- Just (tc,_,_) -> tyConFamilySize tc
+ foldr (addSize . size_up_alt) sizeZero alts
+ `addSizeN` 1 -- charge one for the case itself.
+
+-- Just charge for the alts that exist, not the ones that might exist
+-- `addSizeN`
+-- case (splitAlgTyConApp_maybe (coreExprType scrut)) of
+-- Nothing -> 1
+-- Just (tc,_,_) -> tyConFamilySize tc
------------
size_up_app (App fun arg) args = size_up_app fun (arg:args)
- size_up_app fun args = foldr (addSize . size_up) (fun_discount fun) args
+ size_up_app fun args = foldr (addSize . nukeScrutDiscount . size_up)
+ (size_up_fun fun)
+ args
-- A function application with at least one value argument
-- so if the function is an argument give it an arg-discount
-- Also behave specially if the function is a build
- fun_discount (Var fun) | idUnique fun == buildIdKey = buildSize
- | fun `is_elem` args = scrutArg fun
- fun_discount other = sizeZero
+ size_up_fun (Var fun) | idUnique fun == buildIdKey = buildSize
+ | idUnique fun == augmentIdKey = augmentSize
+ | fun `is_elem` args = scrutArg fun `addSize` sizeOne
+ size_up_fun other = size_up other
------------
size_up_alt (con, bndrs, rhs) = size_up rhs
-- build t (\cn -> e) should cost only the cost of e (because build will be inlined later)
-- Indeed, we should add a result_discount becuause build is
-- very like a constructor. We don't bother to check that the
- -- build is saturated (it usually is). The "-2" discounts for the \c n
+ -- build is saturated (it usually is). The "-2" discounts for the \c n,
-- The "4" is rather arbitrary.
+
+augmentSize = SizeIs (-2#) emptyBag 4#
+ -- Ditto (augment t (\cn -> e) ys) should cost only the cost of
+ -- e plus ys. The -2 accounts for the \cn
scrutArg v = SizeIs 0# (unitBag v) 0#
certainlySmallEnoughToInline :: UnfoldingGuidance -> Bool
certainlySmallEnoughToInline UnfoldNever = False
-certainlySmallEnoughToInline UnfoldAlways = True
certainlySmallEnoughToInline (UnfoldIfGoodArgs _ _ size _) = size <= opt_UF_UseThreshold
\end{code}
\begin{code}
callSiteInline :: Bool -- True <=> the Id is black listed
-> Bool -- 'inline' note at call site
+ -> OccInfo
-> Id -- The Id
- -> [CoreExpr] -- Arguments
+ -> [Bool] -- One for each value arg; True if it is interesting
-> Bool -- True <=> continuation is interesting
-> Maybe CoreExpr -- Unfolding, if any
-callSiteInline black_listed inline_call id args interesting_cont
+callSiteInline black_listed inline_call occ id arg_infos interesting_cont
= case getIdUnfolding id of {
NoUnfolding -> Nothing ;
OtherCon _ -> Nothing ;
- CoreUnfolding form guidance unf_template ->
+ CompulsoryUnfolding unf_template -> Just unf_template ;
+ CoreUnfolding unf_template is_top is_cheap _ guidance ->
let
result | yes_or_no = Just unf_template
| otherwise = Nothing
- inline_prag = getInlinePragma id
- arg_infos = map interestingArg val_args
- val_args = filter isValArg args
- whnf = whnfOrBottom form
-
- yes_or_no =
- case inline_prag of
- IAmDead -> pprTrace "callSiteInline: dead" (ppr id) False
- IMustNotBeINLINEd -> False
- IAmALoopBreaker -> False
- IMustBeINLINEd -> True -- Overrides absolutely everything, including the black list
- ICanSafelyBeINLINEd in_lam one_br -> consider in_lam one_br
- NoInlinePragInfo -> consider InsideLam False
-
- consider in_lam one_branch
+ n_val_args = length arg_infos
+
+ yes_or_no
| black_listed = False
+ | 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
| inline_call = True
- | one_branch -- Be very keen to inline something if this is its unique occurrence; that
- -- gives a good chance of eliminating the original binding for the thing.
- -- 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.
- = WARN( case in_lam of { NotInsideLam -> True; other -> False },
- text "callSiteInline:oneOcc" <+> ppr id )
- -- If it has one occurrence, not inside a lambda, PreInlineUnconditionally
- -- should have zapped it already
- whnf && (not (null args) || interesting_cont)
-
- | otherwise -- Occurs (textually) more than once, so look at its size
+
+ | once_in_one_branch -- Be very keen to inline something if this is its unique occurrence; that
+ -- gives a good chance of eliminating the original binding for the thing.
+ -- 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.
+ = not in_lam || not (null arg_infos) || interesting_cont
+
+ | otherwise
= case guidance of
- UnfoldAlways -> True
- UnfoldNever -> False
+ UnfoldNever -> False ;
UnfoldIfGoodArgs n_vals_wanted arg_discounts size res_discount
- | enough_args && size <= (n_vals_wanted + 1)
+
+ | enough_args && size <= (n_vals_wanted + 1)
-- No size increase
-- Size of call is n_vals_wanted (+1 for the function)
- -> case in_lam of
- NotInsideLam -> True
- InsideLam -> whnf
-
- | not (or arg_infos || really_interesting_cont)
- -- If it occurs more than once, there must be something interesting
- -- about some argument, or the result, to make it worth inlining
- -> False
-
- | otherwise
- -> case in_lam of
- NotInsideLam -> small_enough
- InsideLam -> whnf && small_enough
-
- where
- n_args = length arg_infos
- enough_args = n_args >= n_vals_wanted
- really_interesting_cont | n_args < n_vals_wanted = False -- Too few args
- | n_args == n_vals_wanted = interesting_cont
- | otherwise = True -- Extra args
- -- This rather elaborate defn for really_interesting_cont is important
- -- Consider an I# = INLINE (\x -> I# {x})
- -- The unfolding guidance deems it to have size 2, and no arguments.
- -- So in an application (I# y) we must take the extra arg 'y' as
- -- evidence of an interesting context!
-
- small_enough = (size - discount) <= opt_UF_UseThreshold
- discount = computeDiscount n_vals_wanted arg_discounts res_discount
+ -> True
+
+ | otherwise
+ -> some_benefit && small_enough
+
+ 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.
+
+ 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
+ | otherwise = True -- Extra args
+ -- really_interesting_cont tells if the result of the
+ -- call is in an interesting context.
+
+ small_enough = (size - discount) <= opt_UF_UseThreshold
+ discount = computeDiscount n_vals_wanted arg_discounts res_discount
arg_infos really_interesting_cont
-
-
+
in
#ifdef DEBUG
if opt_D_dump_inlinings then
pprTrace "Considering inlining"
(ppr id <+> vcat [text "black listed" <+> ppr black_listed,
- text "inline prag:" <+> ppr inline_prag,
+ text "occ info:" <+> ppr occ,
text "arg infos" <+> ppr arg_infos,
text "interesting continuation" <+> ppr interesting_cont,
- text "whnf" <+> ppr whnf,
+ 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
result
}
--- An argument is interesting if it has *some* structure
--- We are here trying to avoid unfolding a function that
--- is applied only to variables that have no unfolding
--- (i.e. they are probably lambda bound): f x y z
--- There is little point in inlining f here.
-interestingArg (Type _) = False
-interestingArg (App fn (Type _)) = interestingArg fn
-interestingArg (Var v) = hasUnfolding (getIdUnfolding v)
-interestingArg other = True
-
-
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)
-- we also discount 1 for each argument passed, because these will
-- reduce with the lambdas in the function (we count 1 for a lambda
-- in size_up).
- = length (take n_vals_wanted arg_infos) +
+ = 1 + -- Discount of 1 because the result replaces the call
+ -- so we count 1 for the function itself
+ length (take n_vals_wanted arg_infos) +
-- Discount of 1 for each arg supplied, because the
-- result replaces the call
round (opt_UF_KeenessFactor *
in that order. The meanings of these are determined by the @blackListed@ function
here.
+The final simplification doesn't have a phase number
+
+Pragmas
+~~~~~~~
+ Pragma Black list if
+
+(least black listing, most inlining)
+ INLINE n foo phase is Just p *and* p<n *and* foo appears on LHS of rule
+ INLINE foo phase is Just p *and* foo appears on LHS of rule
+ NOINLINE n foo phase is Just p *and* (p<n *or* foo appears on LHS of rule)
+ NOINLINE foo always
+(most black listing, least inlining)
+
\begin{code}
blackListed :: IdSet -- Used in transformation rules
-> Maybe Int -- Inline phase
-- inlined because of the inline phase we are in. This is the sole
-- place that the inline phase number is looked at.
--- Phase 0: used for 'no inlinings please'
+blackListed rule_vars Nothing -- Last phase
+ = \v -> case getInlinePragma v of
+ IMustNotBeINLINEd False Nothing -> True -- An unconditional NOINLINE pragma
+ other -> False
+
blackListed rule_vars (Just 0)
- = \v -> True
-
--- Phase 1: don't inline any rule-y things or things with specialisations
-blackListed rule_vars (Just 1)
- = \v -> let v_uniq = idUnique v
- in v `elemVarSet` rule_vars
- || not (isEmptyCoreRules (getIdSpecialisation v))
- || v_uniq == runSTRepIdKey
-
--- Phase 2: allow build/augment to inline, and specialisations
-blackListed rule_vars (Just 2)
- = \v -> let v_uniq = idUnique v
- in (v `elemVarSet` rule_vars && not (v_uniq == buildIdKey ||
- v_uniq == augmentIdKey))
- || v_uniq == runSTRepIdKey
-
--- Otherwise just go for it
-blackListed rule_vars phase
- = \v -> False
+-- Phase 0: used for 'no imported inlinings please'
+-- This prevents wrappers getting inlined which in turn is bad for full laziness
+-- NEW: try using 'not a wrapper' rather than 'not imported' in this phase.
+-- This allows a little more inlining, which seems to be important, sometimes.
+-- For example PrelArr.newIntArr gets better.
+ = \v -> -- workerExists (getIdWorkerInfo v) || normal_case rule_vars 0 v
+ -- True -- Try going back to no inlinings at all
+ -- BUT: I found that there is some advantage in doing
+ -- local inlinings first. For example in fish/Main.hs
+ -- it's advantageous to inline scale_vec2 before inlining
+ -- wrappers from PrelNum that make it look big.
+ not (isLocallyDefined v) -- This seems best at the moment
+
+blackListed rule_vars (Just phase)
+ = \v -> normal_case rule_vars phase v
+
+normal_case rule_vars phase v
+ = case getInlinePragma v of
+ NoInlinePragInfo -> has_rules
+
+ IMustNotBeINLINEd from_INLINE Nothing
+ | from_INLINE -> has_rules -- Black list until final phase
+ | otherwise -> True -- Always blacklisted
+
+ IMustNotBeINLINEd from_inline (Just threshold)
+ | from_inline -> phase < threshold && has_rules
+ | otherwise -> phase < threshold || has_rules
+ where
+ has_rules = v `elemVarSet` rule_vars
+ || not (isEmptyCoreRules (getIdSpecialisation v))
\end{code}
projects / ghc-hetmet.git / blobdiff