X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FIdInfo.lhs;h=d53bf5627d99638a48f0f07e57eb846b4e0dc65a;hb=36436bc62a98f53e126ec02fe946337c4c766c3f;hp=f73ba4f65d78131255862ddb9bd01f592f8af413;hpb=e28748e717e49694e70b60eef0f27887b8445583;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs index f73ba4f..d53bf56 100644 --- a/ghc/compiler/basicTypes/IdInfo.lhs +++ b/ghc/compiler/basicTypes/IdInfo.lhs @@ -8,106 +8,274 @@ Haskell. [WDP 94/11]) \begin{code} module IdInfo ( - IdInfo, -- Abstract + GlobalIdDetails(..), notGlobalId, -- Not abstract - vanillaIdInfo, mkIdInfo, seqIdInfo, megaSeqIdInfo, + IdInfo, -- Abstract + vanillaIdInfo, noCafIdInfo, + seqIdInfo, megaSeqIdInfo, -- Zapping - zapFragileInfo, zapLamInfo, zapSpecPragInfo, copyIdInfo, - - -- Flavour - IdFlavour(..), flavourInfo, - setNoDiscardInfo, - ppFlavourInfo, + zapLamInfo, zapDemandInfo, -- Arity - ArityInfo(..), - exactArity, atLeastArity, unknownArity, hasArity, - arityInfo, setArityInfo, ppArityInfo, arityLowerBound, + ArityInfo, + unknownArity, + arityInfo, setArityInfo, ppArityInfo, + -- New demand and strictness info + newStrictnessInfo, setNewStrictnessInfo, + newDemandInfo, setNewDemandInfo, pprNewStrictness, + setAllStrictnessInfo, + +#ifdef OLD_STRICTNESS -- Strictness; imported from Demand StrictnessInfo(..), mkStrictnessInfo, noStrictnessInfo, ppStrictnessInfo,isBottomingStrictness, - - strictnessInfo, setStrictnessInfo, +#endif -- Worker WorkerInfo(..), workerExists, wrapperArity, workerId, workerInfo, setWorkerInfo, ppWorkerInfo, -- Unfolding - unfoldingInfo, setUnfoldingInfo, + unfoldingInfo, setUnfoldingInfo, setUnfoldingInfoLazily, - -- DemandInfo +#ifdef OLD_STRICTNESS + -- Old DemandInfo and StrictnessInfo demandInfo, setDemandInfo, + strictnessInfo, setStrictnessInfo, + cprInfoFromNewStrictness, + oldStrictnessFromNew, newStrictnessFromOld, + oldDemand, newDemand, + + -- Constructed Product Result Info + CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo, +#endif -- Inline prags - InlinePragInfo(..), - inlinePragInfo, setInlinePragInfo, pprInlinePragInfo, - isNeverInlinePrag, neverInlinePrag, + InlinePragInfo, + inlinePragInfo, setInlinePragInfo, -- Occurrence info - OccInfo(..), isFragileOccInfo, + OccInfo(..), isFragileOcc, isDeadOcc, isLoopBreaker, InsideLam, OneBranch, insideLam, notInsideLam, oneBranch, notOneBranch, occInfo, setOccInfo, -- Specialisation - specInfo, setSpecInfo, - - -- Update - UpdateInfo, UpdateSpec, - mkUpdateInfo, updateInfo, updateInfoMaybe, ppUpdateInfo, setUpdateInfo, + SpecInfo(..), specInfo, setSpecInfo, isEmptySpecInfo, + specInfoFreeVars, specInfoRules, seqSpecInfo, -- CAF info - CafInfo(..), cafInfo, setCafInfo, ppCafInfo, - - -- Constructed Product Result Info - CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo, + CafInfo(..), cafInfo, ppCafInfo, setCafInfo, mayHaveCafRefs, -- Lambda-bound variable info - LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo + LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo, hasNoLBVarInfo ) where #include "HsVersions.h" import CoreSyn +import Class ( Class ) import PrimOp ( PrimOp ) import Var ( Id ) -import BasicTypes ( OccInfo(..), isFragileOccInfo, seqOccInfo, +import VarSet ( VarSet, emptyVarSet, seqVarSet ) +import BasicTypes ( OccInfo(..), isFragileOcc, isDeadOcc, seqOccInfo, isLoopBreaker, InsideLam, insideLam, notInsideLam, OneBranch, oneBranch, notOneBranch, - Arity + Arity, + Activation(..) ) import DataCon ( DataCon ) -import FieldLabel ( FieldLabel ) -import Demand -- Lots of stuff +import TyCon ( TyCon, FieldLabel ) +import ForeignCall ( ForeignCall ) +import NewDemand import Outputable -import Maybe ( isJust ) - -infixl 1 `setUpdateInfo`, - `setDemandInfo`, - `setStrictnessInfo`, - `setSpecInfo`, +import Maybe ( isJust ) + +#ifdef OLD_STRICTNESS +import Name ( Name ) +import Demand hiding( Demand, seqDemand ) +import qualified Demand +import Util ( listLengthCmp ) +import List ( replicate ) +#endif + +-- infixl so you can say (id `set` a `set` b) +infixl 1 `setSpecInfo`, `setArityInfo`, `setInlinePragInfo`, `setUnfoldingInfo`, - `setCprInfo`, `setWorkerInfo`, + `setLBVarInfo`, + `setOccInfo`, `setCafInfo`, - `setOccInfo` - -- infixl so you can say (id `set` a `set` b) + `setNewStrictnessInfo`, + `setAllStrictnessInfo`, + `setNewDemandInfo` +#ifdef OLD_STRICTNESS + , `setCprInfo` + , `setDemandInfo` + , `setStrictnessInfo` +#endif +\end{code} + +%************************************************************************ +%* * +\subsection{New strictness info} +%* * +%************************************************************************ + +To be removed later + +\begin{code} +-- setAllStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo +-- Set old and new strictness info +setAllStrictnessInfo info Nothing + = info { newStrictnessInfo = Nothing +#ifdef OLD_STRICTNESS + , strictnessInfo = NoStrictnessInfo + , cprInfo = NoCPRInfo +#endif + } + +setAllStrictnessInfo info (Just sig) + = info { newStrictnessInfo = Just sig +#ifdef OLD_STRICTNESS + , strictnessInfo = oldStrictnessFromNew sig + , cprInfo = cprInfoFromNewStrictness sig +#endif + } + +seqNewStrictnessInfo Nothing = () +seqNewStrictnessInfo (Just ty) = seqStrictSig ty + +pprNewStrictness Nothing = empty +pprNewStrictness (Just sig) = ftext FSLIT("Str:") <+> ppr sig + +#ifdef OLD_STRICTNESS +oldStrictnessFromNew :: StrictSig -> Demand.StrictnessInfo +oldStrictnessFromNew sig = mkStrictnessInfo (map oldDemand dmds, isBotRes res_info) + where + (dmds, res_info) = splitStrictSig sig + +cprInfoFromNewStrictness :: StrictSig -> CprInfo +cprInfoFromNewStrictness sig = case strictSigResInfo sig of + RetCPR -> ReturnsCPR + other -> NoCPRInfo + +newStrictnessFromOld :: Name -> Arity -> Demand.StrictnessInfo -> CprInfo -> StrictSig +newStrictnessFromOld name arity (Demand.StrictnessInfo ds res) cpr + | listLengthCmp ds arity /= GT -- length ds <= arity + -- Sometimes the old strictness analyser has more + -- demands than the arity justifies + = mk_strict_sig name arity $ + mkTopDmdType (map newDemand ds) (newRes res cpr) + +newStrictnessFromOld name arity other cpr + = -- Either no strictness info, or arity is too small + -- In either case we can't say anything useful + mk_strict_sig name arity $ + mkTopDmdType (replicate arity lazyDmd) (newRes False cpr) + +mk_strict_sig name arity dmd_ty + = WARN( arity /= dmdTypeDepth dmd_ty, ppr name <+> (ppr arity $$ ppr dmd_ty) ) + mkStrictSig dmd_ty + +newRes True _ = BotRes +newRes False ReturnsCPR = retCPR +newRes False NoCPRInfo = TopRes + +newDemand :: Demand.Demand -> NewDemand.Demand +newDemand (WwLazy True) = Abs +newDemand (WwLazy False) = lazyDmd +newDemand WwStrict = evalDmd +newDemand (WwUnpack unpk ds) = Eval (Prod (map newDemand ds)) +newDemand WwPrim = lazyDmd +newDemand WwEnum = evalDmd + +oldDemand :: NewDemand.Demand -> Demand.Demand +oldDemand Abs = WwLazy True +oldDemand Top = WwLazy False +oldDemand Bot = WwStrict +oldDemand (Box Bot) = WwStrict +oldDemand (Box Abs) = WwLazy False +oldDemand (Box (Eval _)) = WwStrict -- Pass box only +oldDemand (Defer d) = WwLazy False +oldDemand (Eval (Prod ds)) = WwUnpack True (map oldDemand ds) +oldDemand (Eval (Poly _)) = WwStrict +oldDemand (Call _) = WwStrict + +#endif /* OLD_STRICTNESS */ +\end{code} + + +\begin{code} +seqNewDemandInfo Nothing = () +seqNewDemandInfo (Just dmd) = seqDemand dmd +\end{code} + + +%************************************************************************ +%* * +\subsection{GlobalIdDetails +%* * +%************************************************************************ + +This type is here (rather than in Id.lhs) mainly because there's +an IdInfo.hi-boot, but no Id.hi-boot, and GlobalIdDetails is imported +(recursively) by Var.lhs. + +\begin{code} +data GlobalIdDetails + = VanillaGlobal -- Imported from elsewhere, a default method Id. + + | RecordSelId -- The Id for a record selector + { sel_tycon :: TyCon + , sel_label :: FieldLabel + , sel_naughty :: Bool -- True <=> naughty + } -- See Note [Naughty record selectors] + -- with MkId.mkRecordSelectorId + + | DataConWorkId DataCon -- The Id for a data constructor *worker* + | DataConWrapId DataCon -- The Id for a data constructor *wrapper* + -- [the only reasons we need to know is so that + -- a) to support isImplicitId + -- b) when desugaring a RecordCon we can get + -- from the Id back to the data con] + + | ClassOpId Class -- An operation of a class + + | PrimOpId PrimOp -- The Id for a primitive operator + | FCallId ForeignCall -- The Id for a foreign call + + | NotGlobalId -- Used as a convenient extra return value from globalIdDetails + +notGlobalId = NotGlobalId + +instance Outputable GlobalIdDetails where + ppr NotGlobalId = ptext SLIT("[***NotGlobalId***]") + ppr VanillaGlobal = ptext SLIT("[GlobalId]") + ppr (DataConWorkId _) = ptext SLIT("[DataCon]") + ppr (DataConWrapId _) = ptext SLIT("[DataConWrapper]") + ppr (ClassOpId _) = ptext SLIT("[ClassOp]") + ppr (PrimOpId _) = ptext SLIT("[PrimOp]") + ppr (FCallId _) = ptext SLIT("[ForeignCall]") + ppr (RecordSelId {}) = ptext SLIT("[RecSel]") \end{code} + +%************************************************************************ +%* * +\subsection{The main IdInfo type} +%* * +%************************************************************************ + An @IdInfo@ gives {\em optional} information about an @Id@. If present it never lies, but it may not be present, in which case there is always a conservative assumption which can be made. - There is one exception: the 'flavour' is *not* optional. - You must not discard it. - It used to be in Var.lhs, but that seems unclean. - Two @Id@s may have different info even though they have the same @Unique@ (and are hence the same @Id@); for example, one might lack the properties attached to the other. @@ -120,19 +288,35 @@ case. KSW 1999-04). \begin{code} data IdInfo = IdInfo { - flavourInfo :: IdFlavour, -- NOT OPTIONAL - arityInfo :: ArityInfo, -- Its arity - demandInfo :: Demand, -- Whether or not it is definitely demanded - specInfo :: CoreRules, -- Specialisations of this function which exist + arityInfo :: !ArityInfo, -- Its arity + specInfo :: SpecInfo, -- Specialisations of this function which exist +#ifdef OLD_STRICTNESS + cprInfo :: CprInfo, -- Function always constructs a product result + demandInfo :: Demand.Demand, -- Whether or not it is definitely demanded strictnessInfo :: StrictnessInfo, -- Strictness properties +#endif workerInfo :: WorkerInfo, -- Pointer to Worker Function + -- Within one module this is irrelevant; the + -- inlining of a worker is handled via the Unfolding + -- WorkerInfo is used *only* to indicate the form of + -- the RHS, so that interface files don't actually + -- need to contain the RHS; it can be derived from + -- the strictness info + unfoldingInfo :: Unfolding, -- Its unfolding - updateInfo :: UpdateInfo, -- Which args should be updated - cafInfo :: CafInfo, - cprInfo :: CprInfo, -- Function always constructs a product result + cafInfo :: CafInfo, -- CAF info lbvarInfo :: LBVarInfo, -- Info about a lambda-bound variable inlinePragInfo :: InlinePragInfo, -- Inline pragma - occInfo :: OccInfo -- How it occurs + occInfo :: OccInfo, -- How it occurs + + newStrictnessInfo :: Maybe StrictSig, -- Reason for Maybe: the DmdAnal phase needs to + -- know whether whether this is the first visit, + -- so it can assign botSig. Other customers want + -- topSig. So Nothing is good. + + newDemandInfo :: Maybe Demand -- Similarly we want to know if there's no + -- known demand yet, for when we are looking for + -- CPR info } seqIdInfo :: IdInfo -> () @@ -140,20 +324,24 @@ seqIdInfo (IdInfo {}) = () megaSeqIdInfo :: IdInfo -> () megaSeqIdInfo info - = seqFlavour (flavourInfo info) `seq` - seqArity (arityInfo info) `seq` - seqDemand (demandInfo info) `seq` - seqRules (specInfo info) `seq` - seqStrictnessInfo (strictnessInfo info) `seq` + = seqSpecInfo (specInfo info) `seq` seqWorker (workerInfo info) `seq` --- seqUnfolding (unfoldingInfo info) `seq` -- Omitting this improves runtimes a little, presumably because -- some unfoldings are not calculated at all +-- seqUnfolding (unfoldingInfo info) `seq` + + seqNewDemandInfo (newDemandInfo info) `seq` + seqNewStrictnessInfo (newStrictnessInfo info) `seq` + +#ifdef OLD_STRICTNESS + Demand.seqDemand (demandInfo info) `seq` + seqStrictnessInfo (strictnessInfo info) `seq` + seqCpr (cprInfo info) `seq` +#endif - seqCaf (cafInfo info) `seq` - seqCpr (cprInfo info) `seq` - seqLBVar (lbvarInfo info) `seq` + seqCaf (cafInfo info) `seq` + seqLBVar (lbvarInfo info) `seq` seqOccInfo (occInfo info) \end{code} @@ -161,195 +349,134 @@ Setters \begin{code} setWorkerInfo info wk = wk `seq` info { workerInfo = wk } -setSpecInfo info sp = PSEQ sp (info { specInfo = sp }) +setSpecInfo info sp = sp `seq` info { specInfo = sp } setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr } setOccInfo info oc = oc `seq` info { occInfo = oc } +#ifdef OLD_STRICTNESS setStrictnessInfo info st = st `seq` info { strictnessInfo = st } +#endif -- Try to avoid spack leaks by seq'ing -setUnfoldingInfo info uf - | isEvaldUnfolding uf && isStrict (demandInfo info) - -- If the unfolding is a value, the demand info may - -- go pear-shaped, so we nuke it. Example: - -- let x = (a,b) in - -- case x of (p,q) -> h p q x - -- Here x is certainly demanded. But after we've nuked - -- the case, we'll get just - -- let x = (a,b) in h a b x - -- and now x is not demanded (I'm assuming h is lazy) - -- This really happens. The solution here is a bit ad hoc... - = info { unfoldingInfo = uf, demandInfo = wwLazy } +setUnfoldingInfoLazily info uf -- Lazy variant to avoid looking at the + = -- unfolding of an imported Id unless necessary + info { unfoldingInfo = uf } -- (In this case the demand-zapping is redundant.) - | otherwise +setUnfoldingInfo info uf -- We do *not* seq on the unfolding info, For some reason, doing so -- actually increases residency significantly. = info { unfoldingInfo = uf } -setUpdateInfo info ud = info { updateInfo = ud } +#ifdef OLD_STRICTNESS setDemandInfo info dd = info { demandInfo = dd } -setArityInfo info ar = info { arityInfo = ar } -setCafInfo info cf = info { cafInfo = cf } setCprInfo info cp = info { cprInfo = cp } -setLBVarInfo info lb = info { lbvarInfo = lb } - -setNoDiscardInfo info = case flavourInfo info of - VanillaId -> info { flavourInfo = NoDiscardId } - other -> info -zapSpecPragInfo info = case flavourInfo info of - SpecPragmaId -> info { flavourInfo = VanillaId } - other -> info +#endif + +setArityInfo info ar = info { arityInfo = ar } +setCafInfo info caf = info { cafInfo = caf } + +setLBVarInfo info lb = {-lb `seq`-} info { lbvarInfo = lb } + +setNewDemandInfo info dd = dd `seq` info { newDemandInfo = dd } +setNewStrictnessInfo info dd = dd `seq` info { newStrictnessInfo = dd } \end{code} \begin{code} vanillaIdInfo :: IdInfo -vanillaIdInfo = mkIdInfo VanillaId - -mkIdInfo :: IdFlavour -> IdInfo -mkIdInfo flv = IdInfo { - flavourInfo = flv, - arityInfo = UnknownArity, - demandInfo = wwLazy, - specInfo = emptyCoreRules, - workerInfo = NoWorker, - strictnessInfo = NoStrictnessInfo, - unfoldingInfo = noUnfolding, - updateInfo = NoUpdateInfo, - cafInfo = MayHaveCafRefs, - cprInfo = NoCPRInfo, - lbvarInfo = NoLBVarInfo, - inlinePragInfo = NoInlinePragInfo, - occInfo = NoOccInfo +vanillaIdInfo + = IdInfo { + cafInfo = vanillaCafInfo, + arityInfo = unknownArity, +#ifdef OLD_STRICTNESS + cprInfo = NoCPRInfo, + demandInfo = wwLazy, + strictnessInfo = NoStrictnessInfo, +#endif + specInfo = emptySpecInfo, + workerInfo = NoWorker, + unfoldingInfo = noUnfolding, + lbvarInfo = NoLBVarInfo, + inlinePragInfo = AlwaysActive, + occInfo = NoOccInfo, + newDemandInfo = Nothing, + newStrictnessInfo = Nothing } + +noCafIdInfo = vanillaIdInfo `setCafInfo` NoCafRefs + -- Used for built-in type Ids in MkId. \end{code} %************************************************************************ %* * -\subsection{Flavour} +\subsection[arity-IdInfo]{Arity info about an @Id@} %* * %************************************************************************ +For locally-defined Ids, the code generator maintains its own notion +of their arities; so it should not be asking... (but other things +besides the code-generator need arity info!) + \begin{code} -data IdFlavour - = VanillaId -- Most Ids are like this - | DataConId DataCon -- The Id for a data constructor *worker* - | DataConWrapId DataCon -- The Id for a data constructor *wrapper* - -- [the only reasons we need to know is so that - -- a) we can suppress printing a definition in the interface file - -- b) when typechecking a pattern we can get from the - -- Id back to the data con] - | PrimOpId PrimOp -- The Id for a primitive operator - | RecordSelId FieldLabel -- The Id for a record selector - | SpecPragmaId -- Don't discard these - | NoDiscardId -- Don't discard these either - -ppFlavourInfo :: IdFlavour -> SDoc -ppFlavourInfo VanillaId = empty -ppFlavourInfo (DataConId _) = ptext SLIT("[DataCon]") -ppFlavourInfo (DataConWrapId _) = ptext SLIT("[DataConWrapper]") -ppFlavourInfo (PrimOpId _) = ptext SLIT("[PrimOp]") -ppFlavourInfo (RecordSelId _) = ptext SLIT("[RecSel]") -ppFlavourInfo SpecPragmaId = ptext SLIT("[SpecPrag]") -ppFlavourInfo NoDiscardId = ptext SLIT("[NoDiscard]") - -seqFlavour :: IdFlavour -> () -seqFlavour f = f `seq` () -\end{code} +type ArityInfo = Arity + -- A partial application of this Id to up to n-1 value arguments + -- does essentially no work. That is not necessarily the + -- same as saying that it has n leading lambdas, because coerces + -- may get in the way. -The @SpecPragmaId@ exists only to make Ids that are -on the *LHS* of bindings created by SPECIALISE pragmas; -eg: s = f Int d -The SpecPragmaId is never itself mentioned; it -exists solely so that the specialiser will find -the call to f, and make specialised version of it. -The SpecPragmaId binding is discarded by the specialiser -when it gathers up overloaded calls. -Meanwhile, it is not discarded as dead code. + -- The arity might increase later in the compilation process, if + -- an extra lambda floats up to the binding site. +unknownArity = 0 :: Arity + +ppArityInfo 0 = empty +ppArityInfo n = hsep [ptext SLIT("Arity"), int n] +\end{code} %************************************************************************ %* * -\subsection[arity-IdInfo]{Arity info about an @Id@} +\subsection{Inline-pragma information} %* * %************************************************************************ -For locally-defined Ids, the code generator maintains its own notion -of their arities; so it should not be asking... (but other things -besides the code-generator need arity info!) - \begin{code} -data ArityInfo - = UnknownArity -- No idea - - | ArityExactly Arity -- Arity is exactly this. We use this when importing a - -- function; it's already been compiled and we know its - -- arity for sure. - - | ArityAtLeast Arity -- Arity is this or greater. We attach this arity to - -- functions in the module being compiled. Their arity - -- might increase later in the compilation process, if - -- an extra lambda floats up to the binding site. - deriving( Eq ) - -seqArity :: ArityInfo -> () -seqArity a = arityLowerBound a `seq` () - -exactArity = ArityExactly -atLeastArity = ArityAtLeast -unknownArity = UnknownArity - -arityLowerBound :: ArityInfo -> Arity -arityLowerBound UnknownArity = 0 -arityLowerBound (ArityAtLeast n) = n -arityLowerBound (ArityExactly n) = n - -hasArity :: ArityInfo -> Bool -hasArity UnknownArity = False -hasArity other = True - -ppArityInfo UnknownArity = empty -ppArityInfo (ArityExactly arity) = hsep [ptext SLIT("__A"), int arity] -ppArityInfo (ArityAtLeast arity) = hsep [ptext SLIT("__AL"), int arity] +type InlinePragInfo = Activation + -- Tells when the inlining is active + -- When it is active the thing may be inlined, depending on how + -- big it is. + -- + -- If there was an INLINE pragma, then as a separate matter, the + -- RHS will have been made to look small with a CoreSyn Inline Note + + -- The default InlinePragInfo is AlwaysActive, so the info serves + -- entirely as a way to inhibit inlining until we want it \end{code} + %************************************************************************ %* * -\subsection{Inline-pragma information} + SpecInfo %* * %************************************************************************ \begin{code} -data InlinePragInfo - = NoInlinePragInfo - | IMustNotBeINLINEd Bool -- True <=> came from an INLINE prag, False <=> came from a NOINLINE prag - (Maybe Int) -- Phase number from pragma, if any - deriving( Eq ) - -- 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 _ Nothing) = True -isNeverInlinePrag other = False - -neverInlinePrag :: InlinePragInfo -neverInlinePrag = IMustNotBeINLINEd True{-should be False? --SDM -} Nothing - -instance Outputable InlinePragInfo where - -- This is now parsed in interface files - ppr NoInlinePragInfo = empty - ppr other_prag = ptext SLIT("__U") <> pprInlinePragInfo other_prag - -pprInlinePragInfo NoInlinePragInfo = empty -pprInlinePragInfo (IMustNotBeINLINEd True Nothing) = empty -pprInlinePragInfo (IMustNotBeINLINEd True (Just n)) = brackets (int n) -pprInlinePragInfo (IMustNotBeINLINEd False Nothing) = brackets (char '!') -pprInlinePragInfo (IMustNotBeINLINEd False (Just n)) = brackets (char '!' <> int n) - -instance Show InlinePragInfo where - showsPrec p prag = showsPrecSDoc p (ppr prag) +-- CoreRules is used only in an idSpecialisation (move to IdInfo?) +data SpecInfo + = SpecInfo [CoreRule] VarSet -- Locally-defined free vars of RHSs + +emptySpecInfo :: SpecInfo +emptySpecInfo = SpecInfo [] emptyVarSet + +isEmptySpecInfo :: SpecInfo -> Bool +isEmptySpecInfo (SpecInfo rs _) = null rs + +specInfoFreeVars :: SpecInfo -> VarSet +specInfoFreeVars (SpecInfo _ fvs) = fvs + +specInfoRules :: SpecInfo -> [CoreRule] +specInfoRules (SpecInfo rules _) = rules + +seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs \end{code} @@ -361,30 +488,43 @@ instance Show InlinePragInfo where If this Id has a worker then we store a reference to it. Worker functions are generated by the worker/wrapper pass. This uses -information from the strictness and CPR analyses. +information from strictness analysis. There might not be a worker, even for a strict function, because: (a) the function might be small enough to inline, so no need for w/w split (b) the strictness info might be "SSS" or something, so no w/w split. +Sometimes the arity of a wrapper changes from the original arity from +which it was generated, so we always emit the "original" arity into +the interface file, as part of the worker info. + +How can this happen? Sometimes we get + f = coerce t (\x y -> $wf x y) +at the moment of w/w split; but the eta reducer turns it into + f = coerce t $wf +which is perfectly fine except that the exposed arity so far as +the code generator is concerned (zero) differs from the arity +when we did the split (2). + +All this arises because we use 'arity' to mean "exactly how many +top level lambdas are there" in interface files; but during the +compilation of this module it means "how many things can I apply +this to". + \begin{code} data WorkerInfo = NoWorker | HasWorker Id Arity -- The Arity is the arity of the *wrapper* at the moment of the - -- w/w split. It had better be the same as the arity of the wrapper - -- at the moment it is spat into the interface file. - -- This Arity just lets us make a (hopefully redundant) sanity check + -- w/w split. See notes above. seqWorker :: WorkerInfo -> () -seqWorker (HasWorker id _) = id `seq` () +seqWorker (HasWorker id a) = id `seq` a `seq` () seqWorker NoWorker = () ppWorkerInfo NoWorker = empty -ppWorkerInfo (HasWorker wk_id _) = ptext SLIT("__P") <+> ppr wk_id - -noWorkerInfo = NoWorker +ppWorkerInfo (HasWorker wk_id _) = ptext SLIT("Worker") <+> ppr wk_id workerExists :: WorkerInfo -> Bool workerExists NoWorker = False @@ -400,48 +540,13 @@ wrapperArity (HasWorker _ a) = a %************************************************************************ %* * -\subsection[update-IdInfo]{Update-analysis info about an @Id@} +\subsection[CG-IdInfo]{Code generator-related information} %* * %************************************************************************ \begin{code} -data UpdateInfo - = NoUpdateInfo - | SomeUpdateInfo UpdateSpec - deriving (Eq, Ord) - -- we need Eq/Ord to cross-chk update infos in interfaces - --- the form in which we pass update-analysis info between modules: -type UpdateSpec = [Int] -\end{code} - -\begin{code} -mkUpdateInfo = SomeUpdateInfo +-- CafInfo is used to build Static Reference Tables (see simplStg/SRT.lhs). -updateInfoMaybe NoUpdateInfo = Nothing -updateInfoMaybe (SomeUpdateInfo []) = Nothing -updateInfoMaybe (SomeUpdateInfo u) = Just u -\end{code} - -Text instance so that the update annotations can be read in. - -\begin{code} -ppUpdateInfo NoUpdateInfo = empty -ppUpdateInfo (SomeUpdateInfo []) = empty -ppUpdateInfo (SomeUpdateInfo spec) = (<>) (ptext SLIT("__UA ")) (hcat (map int spec)) - -- was "__U "; changed to avoid conflict with unfoldings. KSW 1999-07. -\end{code} - -%************************************************************************ -%* * -\subsection[CAF-IdInfo]{CAF-related information} -%* * -%************************************************************************ - -This information is used to build Static Reference Tables (see -simplStg/ComputeSRT.lhs). - -\begin{code} data CafInfo = MayHaveCafRefs -- either: -- (1) A function or static constructor @@ -451,17 +556,17 @@ data CafInfo | NoCafRefs -- A function or static constructor -- that refers to no CAFs. --- LATER: not sure how easy this is... --- | OneCafRef Id +vanillaCafInfo = MayHaveCafRefs -- Definitely safe +mayHaveCafRefs MayHaveCafRefs = True +mayHaveCafRefs _ = False seqCaf c = c `seq` () -ppCafInfo NoCafRefs = ptext SLIT("__C") +ppCafInfo NoCafRefs = ptext SLIT("NoCafRefs") ppCafInfo MayHaveCafRefs = empty \end{code} - %************************************************************************ %* * \subsection[cpr-IdInfo]{Constructed Product Result info about an @Id@} @@ -487,6 +592,7 @@ function has the CPR property and which components of the result are also CPRs. \begin{code} +#ifdef OLD_STRICTNESS data CprInfo = NoCPRInfo | ReturnsCPR -- Yes, this function returns a constructed product @@ -497,9 +603,7 @@ data CprInfo -- We used to keep nested info about sub-components, but -- we never used it so I threw it away -\end{code} -\begin{code} seqCpr :: CprInfo -> () seqCpr ReturnsCPR = () seqCpr NoCPRInfo = () @@ -514,6 +618,7 @@ instance Outputable CprInfo where instance Show CprInfo where showsPrec p c = showsPrecSDoc p (ppr c) +#endif \end{code} @@ -524,36 +629,28 @@ instance Show CprInfo where %************************************************************************ If the @Id@ is a lambda-bound variable then it may have lambda-bound -var info. The usage analysis (UsageSP) detects whether the lambda -binding this var is a ``one-shot'' lambda; that is, whether it is -applied at most once. +var info. Sometimes we know whether the lambda binding this var is a +``one-shot'' lambda; that is, whether it is applied at most once. This information may be useful in optimisation, as computations may safely be floated inside such a lambda without risk of duplicating work. \begin{code} -data LBVarInfo - = NoLBVarInfo - - | IsOneShotLambda -- The lambda that binds this Id is applied - -- at most once - -- HACK ALERT! placing this info here is a short-term hack, - -- but it minimises changes to the rest of the compiler. - -- Hack agreed by SLPJ/KSW 1999-04. +data LBVarInfo = NoLBVarInfo + | IsOneShotLambda -- The lambda is applied at most once). seqLBVar l = l `seq` () \end{code} \begin{code} +hasNoLBVarInfo NoLBVarInfo = True +hasNoLBVarInfo IsOneShotLambda = False + noLBVarInfo = NoLBVarInfo --- not safe to print or parse LBVarInfo because it is not really a --- property of the definition, but a property of the context. pprLBVarInfo NoLBVarInfo = empty -pprLBVarInfo IsOneShotLambda = getPprStyle $ \ sty -> - if ifaceStyle sty then empty - else ptext SLIT("OneShot") +pprLBVarInfo IsOneShotLambda = ptext SLIT("OneShot") instance Outputable LBVarInfo where ppr = pprLBVarInfo @@ -569,104 +666,34 @@ instance Show LBVarInfo where %* * %************************************************************************ -zapFragileInfo is used when cloning binders, mainly in the -simplifier. We must forget about used-once information because that -isn't necessarily correct in the transformed program. -Also forget specialisations and unfoldings because they would need -substitution to be correct. (They get pinned back on separately.) - -\begin{code} -zapFragileInfo :: IdInfo -> Maybe IdInfo -zapFragileInfo info@(IdInfo {occInfo = occ, - workerInfo = wrkr, - specInfo = rules, - unfoldingInfo = unfolding}) - | not (isFragileOccInfo occ) - -- We must forget about whether it was marked safe-to-inline, - -- because that isn't necessarily true in the simplified expression. - -- This is important because expressions may be re-simplified - -- We don't zap deadness or loop-breaker-ness. - -- The latter is important because it tells MkIface not to - -- spit out an inlining for the thing. The former doesn't - -- seem so important, but there's no harm. - - && isEmptyCoreRules rules - -- Specialisations would need substituting. They get pinned - -- back on separately. - - && not (workerExists wrkr) - - && not (hasUnfolding unfolding) - -- This is very important; occasionally a let-bound binder is used - -- as a binder in some lambda, in which case its unfolding is utterly - -- bogus. Also the unfolding uses old binders so if we left it we'd - -- have to substitute it. Much better simply to give the Id a new - -- unfolding each time, which is what the simplifier does. - = Nothing - - | otherwise - = Just (info {occInfo = robust_occ_info, - workerInfo = noWorkerInfo, - specInfo = emptyCoreRules, - unfoldingInfo = noUnfolding}) - where - -- It's important to keep the loop-breaker info, - -- because the substitution doesn't remember it. - robust_occ_info = case occ of - OneOcc _ _ -> NoOccInfo - other -> occ -\end{code} - @zapLamInfo@ is used for lambda binders that turn out to to be part of an unsaturated lambda \begin{code} zapLamInfo :: IdInfo -> Maybe IdInfo -zapLamInfo info@(IdInfo {occInfo = occ, demandInfo = demand}) - | is_safe_occ && not (isStrict demand) +zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand}) + | is_safe_occ occ && is_safe_dmd demand = Nothing | otherwise - = Just (info {occInfo = safe_occ, - demandInfo = wwLazy}) + = Just (info {occInfo = safe_occ, newDemandInfo = Nothing}) where -- The "unsafe" occ info is the ones that say I'm not in a lambda -- because that might not be true for an unsaturated lambda - is_safe_occ = case occ of - OneOcc in_lam once -> in_lam - other -> True + is_safe_occ (OneOcc in_lam _ _) = in_lam + is_safe_occ other = True safe_occ = case occ of - OneOcc _ once -> OneOcc insideLam once - other -> occ -\end{code} - - -copyIdInfo is used when shorting out a top-level binding - f_local = BIG - f = f_local -where f is exported. We are going to swizzle it around to - f = BIG - f_local = f -but we must be careful to combine their IdInfos right. -The fact that things can go wrong here is a bad sign, but I can't see -how to make it 'patently right', so copyIdInfo is derived (pretty much) by trial and error + OneOcc _ once int_cxt -> OneOcc insideLam once int_cxt + other -> occ -Here 'from' is f_local, 'to' is f, and the result is attached to f + is_safe_dmd Nothing = True + is_safe_dmd (Just dmd) = not (isStrictDmd dmd) +\end{code} \begin{code} -copyIdInfo :: IdInfo -- From - -> IdInfo -- To - -> IdInfo -- To, updated with stuff from From; except flavour unchanged -copyIdInfo from to = from { flavourInfo = flavourInfo to, - specInfo = specInfo to, - inlinePragInfo = inlinePragInfo to - } - -- It's important to preserve the inline pragma on 'f'; e.g. consider - -- {-# NOINLINE f #-} - -- f = local - -- - -- similarly, transformation rules may be attached to f - -- and we want to preserve them. - -- - -- On the other hand, we want the strictness info from f_local. +zapDemandInfo :: IdInfo -> Maybe IdInfo +zapDemandInfo info@(IdInfo {newDemandInfo = dmd}) + | isJust dmd = Just (info {newDemandInfo = Nothing}) + | otherwise = Nothing \end{code} +