From 95929be07d802527e15124d8d93c2b7ae5de4dd6 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Wed, 24 May 2000 15:47:13 +0000
Subject: [PATCH] [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.
---
ghc/compiler/basicTypes/IdInfo.lhs | 11 +++++++++++
ghc/compiler/coreSyn/CoreUnfold.lhs | 21 ++++++++-------------
ghc/compiler/main/MkIface.lhs | 7 ++-----
ghc/compiler/simplCore/Simplify.lhs | 6 +++---
ghc/compiler/stranal/StrictAnal.lhs | 6 +++---
ghc/compiler/stranal/WorkWrap.lhs | 10 +++++++---
6 files changed, 34 insertions(+), 27 deletions(-)
diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs
index c94e81b39f2f..502a904913ea 100644
--- a/ghc/compiler/basicTypes/IdInfo.lhs
+++ b/ghc/compiler/basicTypes/IdInfo.lhs
@@ -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
diff --git a/ghc/compiler/coreSyn/CoreUnfold.lhs b/ghc/compiler/coreSyn/CoreUnfold.lhs
index 774877898ab2..7276e3480d4f 100644
--- a/ghc/compiler/coreSyn/CoreUnfold.lhs
+++ b/ghc/compiler/coreSyn/CoreUnfold.lhs
@@ -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))
diff --git a/ghc/compiler/main/MkIface.lhs b/ghc/compiler/main/MkIface.lhs
index 6ed5e4c8b5f7..50ebde38374d 100644
--- a/ghc/compiler/main/MkIface.lhs
+++ b/ghc/compiler/main/MkIface.lhs
@@ -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
diff --git a/ghc/compiler/simplCore/Simplify.lhs b/ghc/compiler/simplCore/Simplify.lhs
index f6ccf6a39ca1..92bb34c85081 100644
--- a/ghc/compiler/simplCore/Simplify.lhs
+++ b/ghc/compiler/simplCore/Simplify.lhs
@@ -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
diff --git a/ghc/compiler/stranal/StrictAnal.lhs b/ghc/compiler/stranal/StrictAnal.lhs
index 3e83e2218cd2..032176a6e1dd 100644
--- a/ghc/compiler/stranal/StrictAnal.lhs
+++ b/ghc/compiler/stranal/StrictAnal.lhs
@@ -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
diff --git a/ghc/compiler/stranal/WorkWrap.lhs b/ghc/compiler/stranal/WorkWrap.lhs
index 92eaf088aa0c..15736354b063 100644
--- a/ghc/compiler/stranal/WorkWrap.lhs
+++ b/ghc/compiler/stranal/WorkWrap.lhs
@@ -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)
--
GitLab