-- Inline prags
InlinePragInfo(..),
inlinePragInfo, setInlinePragInfo, pprInlinePragInfo,
+ isNeverInlinePrag, neverInlinePrag,
-- Occurrence info
OccInfo(..), isFragileOccInfo,
(Maybe Int) -- Phase number from pragma, if any
-- The True, Nothing case doesn't need to be recorded
+ -- SEE COMMENTS WITH CoreUnfold.blackListed on the
+ -- exact significance of the IMustNotBeINLINEd pragma
+
+isNeverInlinePrag :: InlinePragInfo -> Bool
+isNeverInlinePrag (IMustNotBeINLINEd True Nothing) = True
+isNeverInlinePrag other = False
+
+neverInlinePrag :: InlinePragInfo
+neverInlinePrag = IMustNotBeINLINEd True Nothing
+
instance Outputable InlinePragInfo where
-- This is now parsed in interface files
ppr NoInlinePragInfo = empty
import Name ( isLocallyDefined )
import Literal ( isLitLitLit )
import PrimOp ( PrimOp(..), primOpIsDupable, primOpOutOfLine, ccallIsCasm )
-import IdInfo ( ArityInfo(..), InlinePragInfo(..), OccInfo(..), IdFlavour(..), CprInfo(..), insideLam, workerExists )
+import IdInfo ( ArityInfo(..), InlinePragInfo(..), OccInfo(..), IdFlavour(..), CprInfo(..),
+ insideLam, workerExists, isNeverInlinePrag
+ )
import TyCon ( tyConFamilySize )
import Type ( splitFunTy_maybe, isUnLiftedType )
import Unique ( Unique, buildIdKey, augmentIdKey )
certainlyWillInline v
= case idUnfolding v of
- CoreUnfolding _ _ _ is_value _ (UnfoldIfGoodArgs n_vals _ size _)
+ CoreUnfolding _ _ _ is_value _ g@(UnfoldIfGoodArgs n_vals _ size _)
-> is_value
&& size - (n_vals +1) <= opt_UF_UseThreshold
- && not never_inline
other -> False
- where
- never_inline = case idInlinePragma v of
- IMustNotBeINLINEd False Nothing -> True
- other -> False
\end{code}
@okToUnfoldInHifile@ is used when emitting unfolding info into an interface
in that order. The meanings of these are determined by the @blackListed@ function
here.
-The final simplification doesn't have a phase number
+The final simplification doesn't have a phase number.
Pragmas
~~~~~~~
-- place that the inline phase number is looked at.
blackListed rule_vars Nothing -- Last phase
- = \v -> case idInlinePragma v of
- IMustNotBeINLINEd False Nothing -> True -- An unconditional NOINLINE pragma
- other -> False
+ = \v -> isNeverInlinePrag (idInlinePragma v)
blackListed rule_vars (Just phase)
= \v -> normal_case rule_vars phase v
| otherwise -> True -- Always blacklisted
IMustNotBeINLINEd from_inline (Just threshold)
- | from_inline -> phase < threshold && has_rules
- | otherwise -> phase < threshold || has_rules
+ | from_inline -> (phase < threshold && has_rules)
+ | otherwise -> (phase < threshold || has_rules)
where
has_rules = v `elemVarSet` rule_vars
|| not (isEmptyCoreRules (idSpecialisation v))
strictnessInfo, ppStrictnessInfo, isBottomingStrictness,
cafInfo, ppCafInfo, specInfo,
cprInfo, ppCprInfo, pprInlinePragInfo,
- occInfo,
+ occInfo, isNeverInlinePrag,
workerExists, workerInfo, ppWorkerInfo, WorkerInfo(..)
)
import CoreSyn ( CoreExpr, CoreBind, Bind(..), rulesRules, rulesRhsFreeVars )
------------ Unfolding --------------
inline_pragma = inlinePragInfo core_idinfo
- dont_inline = case inline_pragma of
- IMustNotBeINLINEd False Nothing -> True -- Unconditional NOINLINE
- other -> False
-
+ dont_inline = isNeverInlinePrag inline_pragma
unfold_pretty | show_unfold = ptext SLIT("__U") <> pprInlinePragInfo inline_pragma <+> pprIfaceUnfolding rhs
| otherwise = empty
-- we'll get another opportunity when we get to the ocurrence(s)
postInlineUnconditionally black_listed occ_info bndr rhs
- | isExportedId bndr ||
- black_listed ||
- isLoopBreaker occ_info = False -- Don't inline these
+ | isExportedId bndr = False -- Don't inline these, ever
+ | black_listed = False
+ | isLoopBreaker occ_info = False
| otherwise = exprIsTrivial rhs -- Duplicating is free
-- Don't inline even WHNFs inside lambdas; doing so may
-- simply increase allocation when the function is called
idDemandInfo, setIdDemandInfo, isBottomingId,
Id
)
-import IdInfo ( InlinePragInfo(..) )
+import IdInfo ( neverInlinePrag )
import CoreLint ( beginPass, endPass )
import ErrUtils ( dumpIfSet )
import SaAbsInt
in
returnSa (new_str_env, new_abs_env, Rec new_pairs)
+-- Hack alert!
-- Top level divergent bindings are marked NOINLINE
-- This avoids fruitless inlining of top level error functions
addStrictnessInfoToTopId str_val abs_val bndr
= if isBottomingId new_id then
- new_id `setInlinePragma` IMustNotBeINLINEd False Nothing
- -- This is a NOINLINE pragma
+ new_id `setInlinePragma` neverInlinePrag
else
new_id
where
import VarSet
import Type ( Type, isNewType, splitForAllTys, splitFunTys )
import IdInfo ( mkStrictnessInfo, noStrictnessInfo, StrictnessInfo(..),
- CprInfo(..), exactArity, InlinePragInfo(..), WorkerInfo(..)
+ CprInfo(..), exactArity, InlinePragInfo(..), isNeverInlinePrag,
+ WorkerInfo(..)
)
import Demand ( Demand, wwLazy )
import SaLib
-- if two, then a worker and a
-- wrapper.
tryWW non_rec fn_id rhs
- | non_rec
- && certainlyWillInline fn_id
+ | not (isNeverInlinePrag inline_prag)
+ = -- Don't split things that will never be inlined
+ returnUs [ (fn_id, rhs) ]
+
+ | non_rec && certainlyWillInline fn_id
-- No point in worker/wrappering something that is going to be
-- INLINEd wholesale anyway. If the strictness analyser is run
-- twice, this test also prevents wrappers (which are INLINEd)
projects / ghc-hetmet.git / commitdiff