Commit 95929be0 authored by simonpj's avatar simonpj
Browse files

[project @ 2000-05-24 15:47:13 by simonpj]

MERGE 4.07

* This fix cures the weird 'ifaceBinds' error that
  Sven and George tripped over.  It was quite obscure!

  Basically, there was a top level binding
	f = x
  lying around, which CoreToStg didn't like.  Why hadn't
  it been substituted away?  Because it had a NOINLINE
  pragma.  Why did it have a NOINLINE pragma?  Because
  it's an always-diverging function, so we never want to
  inline it.
parent 961bc2a0
......@@ -45,6 +45,7 @@ module IdInfo (
-- Inline prags
InlinePragInfo(..),
inlinePragInfo, setInlinePragInfo, pprInlinePragInfo,
isNeverInlinePrag, neverInlinePrag,
-- Occurrence info
OccInfo(..), isFragileOccInfo,
......@@ -324,6 +325,16 @@ data InlinePragInfo
(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
......
......@@ -54,7 +54,9 @@ import VarSet
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 )
......@@ -435,16 +437,11 @@ certainlyWillInline :: Id -> Bool
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
......@@ -673,7 +670,7 @@ For optimisation we use phase 1,2 and nothing (i.e. no -finline-phase flag)
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
~~~~~~~
......@@ -696,9 +693,7 @@ blackListed :: IdSet -- Used in transformation rules
-- 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
......@@ -712,8 +707,8 @@ 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))
......
......@@ -34,7 +34,7 @@ import IdInfo ( IdInfo, StrictnessInfo(..), ArityInfo, InlinePragInfo(..), inli
strictnessInfo, ppStrictnessInfo, isBottomingStrictness,
cafInfo, ppCafInfo, specInfo,
cprInfo, ppCprInfo, pprInlinePragInfo,
occInfo,
occInfo, isNeverInlinePrag,
workerExists, workerInfo, ppWorkerInfo, WorkerInfo(..)
)
import CoreSyn ( CoreExpr, CoreBind, Bind(..), rulesRules, rulesRhsFreeVars )
......@@ -372,10 +372,7 @@ ifaceId get_idinfo needed_ids is_rec id rhs
------------ 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
......
......@@ -985,9 +985,9 @@ postInlineUnconditionally :: Bool -- Black listed
-- 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
......
......@@ -17,7 +17,7 @@ import Id ( idType, setIdStrictness, setInlinePragma,
idDemandInfo, setIdDemandInfo, isBottomingId,
Id
)
import IdInfo ( InlinePragInfo(..) )
import IdInfo ( neverInlinePrag )
import CoreLint ( beginPass, endPass )
import ErrUtils ( dumpIfSet )
import SaAbsInt
......@@ -186,12 +186,12 @@ saTopBind str_env abs_env (Rec pairs)
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
......
......@@ -23,7 +23,8 @@ import Id ( Id, idType, idStrictness, setIdArityInfo, isOneShotLambda,
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
......@@ -189,8 +190,11 @@ tryWW :: Bool -- True <=> a non-recursive binding
-- 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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment