X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FIdInfo.lhs;h=0db72f1bd6c4cc5a4290d214b382a31badd0f94f;hb=6065c9df3e0621193ccc944e11dc263db8e13354;hp=c92f94318a679b260021c9303f237373a460baf6;hpb=7e602b0a11e567fcb035d1afd34015aebcf9a577;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs index c92f943..0db72f1 100644 --- a/ghc/compiler/basicTypes/IdInfo.lhs +++ b/ghc/compiler/basicTypes/IdInfo.lhs @@ -10,20 +10,31 @@ Haskell. [WDP 94/11]) module IdInfo ( IdInfo, -- Abstract - noIdInfo, - ppIdInfo, + vanillaIdInfo, mkIdInfo, seqIdInfo, megaSeqIdInfo, + + -- Zapping + zapFragileInfo, zapLamInfo, zapSpecPragInfo, shortableIdInfo, copyIdInfo, + + -- Flavour + IdFlavour(..), flavourInfo, + setNoDiscardInfo, + ppFlavourInfo, -- Arity ArityInfo(..), - exactArity, atLeastArity, unknownArity, + exactArity, atLeastArity, unknownArity, hasArity, arityInfo, setArityInfo, ppArityInfo, arityLowerBound, - -- Strictness - StrictnessInfo(..), -- Non-abstract - workerExists, mkStrictnessInfo, - noStrictnessInfo, strictnessInfo, - ppStrictnessInfo, setStrictnessInfo, - isBottomingStrictness, appIsBottom, + -- Strictness; imported from Demand + StrictnessInfo(..), + mkStrictnessInfo, noStrictnessInfo, + ppStrictnessInfo,isBottomingStrictness, + + strictnessInfo, setStrictnessInfo, + + -- Worker + WorkerInfo(..), workerExists, wrapperArity, workerId, + workerInfo, setWorkerInfo, ppWorkerInfo, -- Unfolding unfoldingInfo, setUnfoldingInfo, @@ -32,104 +43,223 @@ module IdInfo ( demandInfo, setDemandInfo, -- Inline prags - InlinePragInfo(..), OccInfo(..), - inlinePragInfo, setInlinePragInfo, notInsideLambda, + InlinePragInfo(..), + inlinePragInfo, setInlinePragInfo, pprInlinePragInfo, + isNeverInlinePrag, neverInlinePrag, - -- Specialisation - IdSpecEnv, specInfo, setSpecInfo, + -- Occurrence info + OccInfo(..), isFragileOcc, isDeadOcc, isLoopBreaker, + InsideLam, OneBranch, insideLam, notInsideLam, oneBranch, notOneBranch, + occInfo, setOccInfo, - -- Update - UpdateInfo, UpdateSpec, - mkUpdateInfo, updateInfo, updateInfoMaybe, ppUpdateInfo, setUpdateInfo, + -- Specialisation + specInfo, setSpecInfo, -- CAF info CafInfo(..), cafInfo, setCafInfo, ppCafInfo, + + -- Constructed Product Result Info + CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo, + + -- Lambda-bound variable info + LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo ) where #include "HsVersions.h" -import {-# SOURCE #-} CoreUnfold ( Unfolding, noUnfolding ) -import {-# SOURCE #-} CoreSyn ( CoreExpr ) - -import SpecEnv ( SpecEnv, emptySpecEnv ) -import Demand ( Demand, isLazy, wwLazy, pprDemands ) +import CoreSyn +import PrimOp ( PrimOp ) +import Var ( Id ) +import BasicTypes ( OccInfo(..), isFragileOcc, isDeadOcc, seqOccInfo, isLoopBreaker, + InsideLam, insideLam, notInsideLam, + OneBranch, oneBranch, notOneBranch, + Arity + ) +import DataCon ( DataCon ) +import FieldLabel ( FieldLabel ) +import Demand -- Lots of stuff import Outputable +import Maybe ( isJust ) + +infixl 1 `setDemandInfo`, + `setStrictnessInfo`, + `setSpecInfo`, + `setArityInfo`, + `setInlinePragInfo`, + `setUnfoldingInfo`, + `setCprInfo`, + `setWorkerInfo`, + `setCafInfo`, + `setOccInfo` + -- infixl so you can say (id `set` a `set` b) \end{code} 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. The @IdInfo@ gives information about the value, or definition, of the @Id@. It does {\em not} contain information about the @Id@'s usage -(except for @DemandInfo@? ToDo). +(except for @DemandInfo@? ToDo). (@lbvarInfo@ is also a marginal +case. KSW 1999-04). \begin{code} data IdInfo = IdInfo { - arityInfo :: ArityInfo, -- Its arity - demandInfo :: Demand, -- Whether or not it is definitely demanded - specInfo :: IdSpecEnv, -- Specialisations of this function which exist - strictnessInfo :: StrictnessInfo, -- Strictness properties - unfoldingInfo :: Unfolding, -- Its unfolding - updateInfo :: UpdateInfo, -- Which args should be updated - cafInfo :: CafInfo, - inlinePragInfo :: !InlinePragInfo -- Inline pragmas + 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 + strictnessInfo :: StrictnessInfo, -- Strictness properties + workerInfo :: WorkerInfo, -- Pointer to Worker Function + unfoldingInfo :: Unfolding, -- Its unfolding + cafInfo :: CafInfo, + cprInfo :: CprInfo, -- Function always constructs a product result + lbvarInfo :: LBVarInfo, -- Info about a lambda-bound variable + inlinePragInfo :: InlinePragInfo, -- Inline pragma + occInfo :: OccInfo -- How it occurs } + +seqIdInfo :: IdInfo -> () +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` + seqWorker (workerInfo info) `seq` + +-- seqUnfolding (unfoldingInfo info) `seq` +-- Omitting this improves runtimes a little, presumably because +-- some unfoldings are not calculated at all + + seqCaf (cafInfo info) `seq` + seqCpr (cprInfo info) `seq` + seqLBVar (lbvarInfo info) `seq` + seqOccInfo (occInfo info) \end{code} Setters \begin{code} -setUpdateInfo ud info = info { updateInfo = ud } -setDemandInfo dd info = info { demandInfo = dd } -setStrictnessInfo st info = info { strictnessInfo = st } -setSpecInfo sp info = info { specInfo = sp } -setArityInfo ar info = info { arityInfo = ar } -setInlinePragInfo pr info = info { inlinePragInfo = pr } -setUnfoldingInfo uf info = info { unfoldingInfo = uf } -setCafInfo cf info = info { cafInfo = cf } +setWorkerInfo info wk = wk `seq` info { workerInfo = wk } +setSpecInfo info sp = PSEQ sp (info { specInfo = sp }) +setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr } +setOccInfo info oc = oc `seq` info { occInfo = oc } +setStrictnessInfo info st = st `seq` info { strictnessInfo = st } + -- 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 } + + | otherwise + -- We do *not* seq on the unfolding info, For some reason, doing so + -- actually increases residency significantly. + = info { unfoldingInfo = uf } + +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 \end{code} \begin{code} -noIdInfo = IdInfo { - arityInfo = UnknownArity, - demandInfo = wwLazy, - specInfo = emptySpecEnv, - strictnessInfo = NoStrictnessInfo, - unfoldingInfo = noUnfolding, - updateInfo = NoUpdateInfo, - cafInfo = MayHaveCafRefs, - inlinePragInfo = NoInlinePragInfo +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, + cafInfo = MayHaveCafRefs, + cprInfo = NoCPRInfo, + lbvarInfo = NoLBVarInfo, + inlinePragInfo = NoInlinePragInfo, + occInfo = NoOccInfo } \end{code} + +%************************************************************************ +%* * +\subsection{Flavour} +%* * +%************************************************************************ + \begin{code} -ppIdInfo :: IdInfo -> SDoc -ppIdInfo (IdInfo {arityInfo, - demandInfo, - specInfo, - strictnessInfo, - unfoldingInfo, - updateInfo, - cafInfo, - inlinePragInfo}) - = hsep [ - ppArityInfo arityInfo, - ppUpdateInfo updateInfo, - ppStrictnessInfo strictnessInfo, - ppr demandInfo, - ppCafInfo cafInfo - -- Inline pragma printed out with all binders; see PprCore.pprIdBndr - ] +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} +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. + + %************************************************************************ %* * \subsection[arity-IdInfo]{Arity info about an @Id@} @@ -143,18 +273,36 @@ besides the code-generator need arity info!) \begin{code} data ArityInfo = UnknownArity -- No idea - | ArityExactly Int -- Arity is exactly this - | ArityAtLeast Int -- Arity is this or greater + + | 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 -- 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. + + -- 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 -> Int +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] @@ -170,238 +318,349 @@ ppArityInfo (ArityAtLeast arity) = hsep [ptext SLIT("__AL"), int arity] \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 - | IAmASpecPragmaId -- Used for spec-pragma Ids; don't discard or inline - - | IWantToBeINLINEd -- User INLINE pragma - | IMustNotBeINLINEd -- User NOINLINE pragma - - | IAmALoopBreaker -- Used by the occurrence analyser to mark loop-breakers - -- in a group of recursive definitions - - | ICanSafelyBeINLINEd -- Used by the occurrence analyser to mark things - -- that manifesly occur once, not inside SCCs, - -- not in constructor arguments + -- SEE COMMENTS WITH CoreUnfold.blackListed on the + -- exact significance of the IMustNotBeINLINEd pragma - OccInfo -- Says whether the occurrence is inside a lambda - -- If so, must only substitute WHNFs +isNeverInlinePrag :: InlinePragInfo -> Bool +isNeverInlinePrag (IMustNotBeINLINEd _ Nothing) = True +isNeverInlinePrag other = False - Bool -- False <=> occurs in more than one case branch - -- If so, there's a code-duplication issue - - | IAmDead -- Marks unused variables. Sometimes useful for - -- lambda and case-bound variables. - - | IMustBeINLINEd -- Absolutely must inline; used for PrimOps and - -- constructors only. +neverInlinePrag :: InlinePragInfo +neverInlinePrag = IMustNotBeINLINEd True{-should be False? --SDM -} Nothing instance Outputable InlinePragInfo where - ppr NoInlinePragInfo = empty - ppr IMustBeINLINEd = ptext SLIT("__UU") - ppr IWantToBeINLINEd = ptext SLIT("__U") - ppr IMustNotBeINLINEd = ptext SLIT("__Unot") - ppr IAmALoopBreaker = ptext SLIT("__Ux") - ppr IAmDead = ptext SLIT("__Ud") - ppr (ICanSafelyBeINLINEd _ _) = ptext SLIT("__Us") - ppr IAmASpecPragmaId = ptext SLIT("__US") - + -- 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) \end{code} -The @IMustNotBeDiscarded@ 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. + +%************************************************************************ +%* * +\subsection[worker-IdInfo]{Worker info about an @Id@} +%* * +%************************************************************************ + +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. + +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. \begin{code} -data OccInfo - = StrictOcc -- Occurs syntactically strictly; - -- i.e. in a function position or case scrutinee - | LazyOcc -- Not syntactically strict (*even* that of a strict function) - -- or in a case branch where there's more than one alternative +data WorkerInfo = NoWorker + | HasWorker Id Arity + -- The Arity is the arity of the *wrapper* at the moment of the + -- w/w split. See comments in MkIface.ifaceId, with the 'Worker' code. + +seqWorker :: WorkerInfo -> () +seqWorker (HasWorker id _) = id `seq` () +seqWorker NoWorker = () - | InsideLam -- Inside a non-linear lambda (that is, a lambda which - -- is sure to be instantiated only once). - -- Substituting a redex for this occurrence is - -- dangerous because it might duplicate work. +ppWorkerInfo NoWorker = empty +ppWorkerInfo (HasWorker wk_id _) = ptext SLIT("__P") <+> ppr wk_id -instance Outputable OccInfo where - ppr StrictOcc = text "s" - ppr LazyOcc = empty - ppr InsideLam = text "l" +noWorkerInfo = NoWorker +workerExists :: WorkerInfo -> Bool +workerExists NoWorker = False +workerExists (HasWorker _ _) = True -notInsideLambda :: OccInfo -> Bool -notInsideLambda StrictOcc = True -notInsideLambda LazyOcc = True -notInsideLambda InsideLam = False +workerId :: WorkerInfo -> Id +workerId (HasWorker id _) = id + +wrapperArity :: WorkerInfo -> Arity +wrapperArity (HasWorker _ a) = a \end{code} + %************************************************************************ %* * -\subsection[specialisation-IdInfo]{Specialisation info about an @Id@} +\subsection[CAF-IdInfo]{CAF-related information} %* * %************************************************************************ -A @IdSpecEnv@ holds details of an @Id@'s specialisations. +This information is used to build Static Reference Tables (see +simplStg/ComputeSRT.lhs). \begin{code} -type IdSpecEnv = SpecEnv CoreExpr -\end{code} - -For example, if \tr{f}'s @SpecEnv@ contains the mapping: -\begin{verbatim} - [List a, b] ===> (\d -> f' a b) -\end{verbatim} -then when we find an application of f to matching types, we simply replace -it by the matching RHS: -\begin{verbatim} - f (List Int) Bool ===> (\d -> f' Int Bool) -\end{verbatim} -All the stuff about how many dictionaries to discard, and what types -to apply the specialised function to, are handled by the fact that the -SpecEnv contains a template for the result of the specialisation. - -There is one more exciting case, which is dealt with in exactly the same -way. If the specialised value is unboxed then it is lifted at its -definition site and unlifted at its uses. For example: +data CafInfo + = MayHaveCafRefs -- either: + -- (1) A function or static constructor + -- that refers to one or more CAFs, + -- (2) A real live CAF - pi :: forall a. Num a => a + | NoCafRefs -- A function or static constructor + -- that refers to no CAFs. -might have a specialisation +-- LATER: not sure how easy this is... +-- | OneCafRef Id - [Int#] ===> (case pi' of Lift pi# -> pi#) -where pi' :: Lift Int# is the specialised version of pi. +seqCaf c = c `seq` () +ppCafInfo NoCafRefs = ptext SLIT("__C") +ppCafInfo MayHaveCafRefs = empty +\end{code} %************************************************************************ %* * -\subsection[strictness-IdInfo]{Strictness info about an @Id@} +\subsection[cpr-IdInfo]{Constructed Product Result info about an @Id@} %* * %************************************************************************ -We specify the strictness of a function by giving information about -each of the ``wrapper's'' arguments (see the description about -worker/wrapper-style transformations in the PJ/Launchbury paper on -unboxed types). +If the @Id@ is a function then it may have CPR info. A CPR analysis +phase detects whether: -The list of @Demands@ specifies: (a)~the strictness properties -of a function's arguments; (b)~the {\em existence} of a ``worker'' -version of the function; and (c)~the type signature of that worker (if -it exists); i.e. its calling convention. +\begin{enumerate} +\item +The function's return value has a product type, i.e. an algebraic type +with a single constructor. Examples of such types are tuples and boxed +primitive values. +\item +The function always 'constructs' the value that it is returning. It +must do this on every path through, and it's OK if it calls another +function which constructs the result. +\end{enumerate} + +If this is the case then we store a template which tells us the +function has the CPR property and which components of the result are +also CPRs. \begin{code} -data StrictnessInfo - = NoStrictnessInfo - - | StrictnessInfo [Demand] - Bool -- True <=> the function diverges regardless of its arguments - -- Useful for "error" and other disguised variants thereof. - -- BUT NB: f = \x y. error "urk" - -- will have info SI [SS] True - -- but still (f) and (f 2) are not bot; only (f 3 2) is bot - - Bool -- True <=> there is a worker. There might not be, 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. +data CprInfo + = NoCPRInfo + | ReturnsCPR -- Yes, this function returns a constructed product + -- Implicitly, this means "after the function has been applied + -- to all its arguments", so the worker/wrapper builder in + -- WwLib.mkWWcpr checks that that it is indeed saturated before + -- making use of the CPR info + + -- We used to keep nested info about sub-components, but + -- we never used it so I threw it away \end{code} \begin{code} -mkStrictnessInfo :: ([Demand], Bool) -> Bool -> StrictnessInfo - -mkStrictnessInfo (xs, is_bot) has_wrkr - | all isLazy xs && not is_bot = NoStrictnessInfo -- Uninteresting - | otherwise = StrictnessInfo xs is_bot has_wrkr - -noStrictnessInfo = NoStrictnessInfo +seqCpr :: CprInfo -> () +seqCpr ReturnsCPR = () +seqCpr NoCPRInfo = () -isBottomingStrictness (StrictnessInfo _ bot _) = bot -isBottomingStrictness NoStrictnessInfo = False +noCprInfo = NoCPRInfo --- appIsBottom returns true if an application to n args would diverge -appIsBottom (StrictnessInfo ds bot _) n = bot && (n >= length ds) -appIsBottom NoStrictnessInfo n = False - -ppStrictnessInfo NoStrictnessInfo = empty -ppStrictnessInfo (StrictnessInfo wrapper_args bot wrkr_maybe) - = hsep [ptext SLIT("__S"), pprDemands wrapper_args bot] -\end{code} +ppCprInfo NoCPRInfo = empty +ppCprInfo ReturnsCPR = ptext SLIT("__M") +instance Outputable CprInfo where + ppr = ppCprInfo -\begin{code} -workerExists :: StrictnessInfo -> Bool -workerExists (StrictnessInfo _ _ worker_exists) = worker_exists -workerExists other = False +instance Show CprInfo where + showsPrec p c = showsPrecSDoc p (ppr c) \end{code} %************************************************************************ %* * -\subsection[update-IdInfo]{Update-analysis info about an @Id@} +\subsection[lbvar-IdInfo]{Lambda-bound var info about an @Id@} %* * %************************************************************************ +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. + +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 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] +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. + +seqLBVar l = l `seq` () \end{code} \begin{code} -mkUpdateInfo = SomeUpdateInfo +noLBVarInfo = NoLBVarInfo -updateInfoMaybe NoUpdateInfo = Nothing -updateInfoMaybe (SomeUpdateInfo []) = Nothing -updateInfoMaybe (SomeUpdateInfo u) = Just u -\end{code} +-- 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") -Text instance so that the update annotations can be read in. +instance Outputable LBVarInfo where + ppr = pprLBVarInfo -\begin{code} -ppUpdateInfo NoUpdateInfo = empty -ppUpdateInfo (SomeUpdateInfo []) = empty -ppUpdateInfo (SomeUpdateInfo spec) = (<>) (ptext SLIT("__U ")) (hcat (map int spec)) +instance Show LBVarInfo where + showsPrec p c = showsPrecSDoc p (ppr c) \end{code} + %************************************************************************ %* * -\subsection[CAF-IdInfo]{CAF-related information} +\subsection{Bulk operations on IdInfo} %* * %************************************************************************ -This information is used to build Static Reference Tables (see -simplStg/ComputeSRT.lhs). +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} -data CafInfo - = MayHaveCafRefs -- either: - -- (1) A function or static constructor - -- that refers to one or more CAFs, - -- (2) A real live CAF +zapFragileInfo :: IdInfo -> Maybe IdInfo +zapFragileInfo info@(IdInfo {occInfo = occ, + workerInfo = wrkr, + specInfo = rules, + unfoldingInfo = unfolding}) + | not (isFragileOcc 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} - | NoCafRefs -- A function or static constructor - -- that refers to no CAFs. +@zapLamInfo@ is used for lambda binders that turn out to to be +part of an unsaturated lambda --- LATER: not sure how easy this is... --- | OneCafRef Id +\begin{code} +zapLamInfo :: IdInfo -> Maybe IdInfo +zapLamInfo info@(IdInfo {occInfo = occ, demandInfo = demand}) + | is_safe_occ && not (isStrict demand) + = Nothing + | otherwise + = Just (info {occInfo = safe_occ, + demandInfo = wwLazy}) + 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 + + safe_occ = case occ of + OneOcc _ once -> OneOcc insideLam once + other -> occ +\end{code} -ppCafInfo NoCafRefs = ptext SLIT("__C") -ppCafInfo MayHaveCafRefs = empty +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 (a) we must be careful about messing up rules + (b) we must ensure f's IdInfo ends up right + +(a) Messing up the rules +~~~~~~~~~~~~~~~~~~~~ +The example that went bad on me was this one: + + iterate :: (a -> a) -> a -> [a] + iterate = iterateList + + iterateFB c f x = x `c` iterateFB c f (f x) + iterateList f x = x : iterateList f (f x) + + {-# RULES + "iterate" forall f x. iterate f x = build (\c _n -> iterateFB c f x) + "iterateFB" iterateFB (:) = iterateList + #-} + +This got shorted out to: + + iterateList :: (a -> a) -> a -> [a] + iterateList = iterate + + iterateFB c f x = x `c` iterateFB c f (f x) + iterate f x = x : iterate f (f x) + + {-# RULES + "iterate" forall f x. iterate f x = build (\c _n -> iterateFB c f x) + "iterateFB" iterateFB (:) = iterate + #-} + +And now we get an infinite loop in the rule system + iterate f x -> build (\cn -> iterateFB c f x + -> iterateFB (:) f x + -> iterate f x + +Tiresome solution: don't do shorting out if f has rewrite rules. +Hence shortableIdInfo. + +(b) Keeping the IdInfo right +~~~~~~~~~~~~~~~~~~~~~~~~ +We want to move strictness/worker info from f_local to f, but keep the rest. +Hence copyIdInfo. + +\begin{code} +shortableIdInfo :: IdInfo -> Bool +shortableIdInfo info = isEmptyCoreRules (specInfo info) + +copyIdInfo :: IdInfo -- f_local + -> IdInfo -- f (the exported one) + -> IdInfo -- New info for f +copyIdInfo f_local f = f { strictnessInfo = strictnessInfo f_local, + workerInfo = workerInfo f_local, + cprInfo = cprInfo f_local + } \end{code}