X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FIdInfo.lhs;h=9446f7d1e406d7747161d96978b43d25d2813b3e;hp=02ef0db1429b223f91011714dfb6bd61856cfc6d;hb=72462499b891d5779c19f3bda03f96e24f9554ae;hpb=7eb8be6b5fcd80c4d9dfde6990dcb9fec4062d6b diff --git a/compiler/basicTypes/IdInfo.lhs b/compiler/basicTypes/IdInfo.lhs index 02ef0db..9446f7d 100644 --- a/compiler/basicTypes/IdInfo.lhs +++ b/compiler/basicTypes/IdInfo.lhs @@ -9,80 +9,86 @@ Haskell. [WDP 94/11]) \begin{code} module IdInfo ( - GlobalIdDetails(..), notGlobalId, -- Not abstract + -- * The IdDetails type + IdDetails(..), pprIdDetails, + -- * The IdInfo type IdInfo, -- Abstract vanillaIdInfo, noCafIdInfo, seqIdInfo, megaSeqIdInfo, - -- Zapping + -- ** Zapping various forms of Info zapLamInfo, zapDemandInfo, zapFragileInfo, - -- Arity + -- ** The ArityInfo type ArityInfo, unknownArity, arityInfo, setArityInfo, ppArityInfo, - -- New demand and strictness info + -- ** Demand and strictness Info newStrictnessInfo, setNewStrictnessInfo, newDemandInfo, setNewDemandInfo, pprNewStrictness, setAllStrictnessInfo, #ifdef OLD_STRICTNESS - -- Strictness; imported from Demand + -- ** Old strictness Info StrictnessInfo(..), mkStrictnessInfo, noStrictnessInfo, - ppStrictnessInfo,isBottomingStrictness, -#endif - - -- Worker - WorkerInfo(..), workerExists, wrapperArity, workerId, - workerInfo, setWorkerInfo, ppWorkerInfo, - - -- Unfolding - unfoldingInfo, setUnfoldingInfo, setUnfoldingInfoLazily, + ppStrictnessInfo, isBottomingStrictness, + strictnessInfo, setStrictnessInfo, + + oldStrictnessFromNew, newStrictnessFromOld, -#ifdef OLD_STRICTNESS - -- Old DemandInfo and StrictnessInfo + -- ** Old demand Info demandInfo, setDemandInfo, - strictnessInfo, setStrictnessInfo, - cprInfoFromNewStrictness, - oldStrictnessFromNew, newStrictnessFromOld, oldDemand, newDemand, - -- Constructed Product Result Info - CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo, + -- ** Old Constructed Product Result Info + CprInfo(..), + cprInfo, setCprInfo, ppCprInfo, noCprInfo, + cprInfoFromNewStrictness, #endif - -- Inline prags - InlinePragInfo, - inlinePragInfo, setInlinePragInfo, - - -- Occurrence info - OccInfo(..), isFragileOcc, isDeadOcc, isLoopBreaker, - InsideLam, OneBranch, insideLam, notInsideLam, oneBranch, notOneBranch, - occInfo, setOccInfo, - - -- Specialisation - SpecInfo(..), specInfo, setSpecInfo, isEmptySpecInfo, - specInfoFreeVars, specInfoRules, seqSpecInfo, - - -- CAF info - CafInfo(..), cafInfo, ppCafInfo, setCafInfo, mayHaveCafRefs, - - -- Lambda-bound variable info - LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo, hasNoLBVarInfo, + -- ** Unfolding Info + unfoldingInfo, setUnfoldingInfo, setUnfoldingInfoLazily, - -- Tick-box info + -- ** The InlinePragInfo type + InlinePragInfo, + inlinePragInfo, setInlinePragInfo, + + -- ** The OccInfo type + OccInfo(..), + isFragileOcc, isDeadOcc, isLoopBreaker, + occInfo, setOccInfo, + + InsideLam, OneBranch, + insideLam, notInsideLam, oneBranch, notOneBranch, + + -- ** The SpecInfo type + SpecInfo(..), + isEmptySpecInfo, specInfoFreeVars, + specInfoRules, seqSpecInfo, setSpecInfoHead, + specInfo, setSpecInfo, + + -- ** The CAFInfo type + CafInfo(..), + ppCafInfo, mayHaveCafRefs, + cafInfo, setCafInfo, + + -- ** The LBVarInfo type + LBVarInfo(..), + noLBVarInfo, hasNoLBVarInfo, + lbvarInfo, setLBVarInfo, + + -- ** Tick-box Info TickBoxOp(..), TickBoxId, ) where -#include "HsVersions.h" +import CoreSyn ( CoreRule, setRuleIdName, seqRules, Unfolding, noUnfolding ) -import CoreSyn import Class import PrimOp -import Var +import Name import VarSet import BasicTypes import DataCon @@ -91,11 +97,11 @@ import ForeignCall import NewDemand import Outputable import Module +import FastString import Data.Maybe #ifdef OLD_STRICTNESS -import Name import Demand import qualified Demand import Util @@ -107,7 +113,6 @@ infixl 1 `setSpecInfo`, `setArityInfo`, `setInlinePragInfo`, `setUnfoldingInfo`, - `setWorkerInfo`, `setLBVarInfo`, `setOccInfo`, `setCafInfo`, @@ -130,8 +135,8 @@ infixl 1 `setSpecInfo`, To be removed later \begin{code} --- setAllStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo --- Set old and new strictness info +-- | Set old and new strictness information together +setAllStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo setAllStrictnessInfo info Nothing = info { newStrictnessInfo = Nothing #ifdef OLD_STRICTNESS @@ -148,11 +153,13 @@ setAllStrictnessInfo info (Just sig) #endif } +seqNewStrictnessInfo :: Maybe StrictSig -> () seqNewStrictnessInfo Nothing = () seqNewStrictnessInfo (Just ty) = seqStrictSig ty -pprNewStrictness Nothing = empty -pprNewStrictness (Just sig) = ftext FSLIT("Str:") <+> ppr sig +pprNewStrictness :: Maybe StrictSig -> SDoc +pprNewStrictness Nothing = empty +pprNewStrictness (Just sig) = ppr sig #ifdef OLD_STRICTNESS oldStrictnessFromNew :: StrictSig -> Demand.StrictnessInfo @@ -212,6 +219,7 @@ oldDemand (Call _) = WwStrict \begin{code} +seqNewDemandInfo :: Maybe Demand -> () seqNewDemandInfo Nothing = () seqNewDemandInfo (Just dmd) = seqDemand dmd \end{code} @@ -219,53 +227,64 @@ seqNewDemandInfo (Just dmd) = seqDemand dmd %************************************************************************ %* * -\subsection{GlobalIdDetails} + IdDetails %* * %************************************************************************ -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 'IdDetails' of an 'Id' give stable, and necessary, +-- information about the Id. +data IdDetails + = VanillaId + + -- | The 'Id' for a record selector + | RecSelId + { sel_tycon :: TyCon -- ^ For a data type family, this is the /instance/ 'TyCon' + -- not the family 'TyCon' + , sel_naughty :: Bool -- True <=> a "naughty" selector which can't actually exist, for example @x@ in: + -- data T = forall a. MkT { x :: a } + } -- See Note [Naughty record selectors] in TcTyClsDecls + + | DataConWorkId DataCon -- ^ The 'Id' is for a data constructor /worker/ + | DataConWrapId DataCon -- ^ The 'Id' is 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 - - | TickBoxOpId TickBoxOp -- The Id for a tick box (both traditional and binary) - - | 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 (TickBoxOpId _) = ptext SLIT("[TickBoxOp]") - ppr (RecordSelId {}) = ptext SLIT("[RecSel]") + | ClassOpId Class -- ^ The 'Id' is an superclass selector or class operation of a class + + | PrimOpId PrimOp -- ^ The 'Id' is for a primitive operator + | FCallId ForeignCall -- ^ The 'Id' is for a foreign call + + | TickBoxOpId TickBoxOp -- ^ The 'Id' is for a HPC tick box (both traditional and binary) + + | DFunId Bool -- ^ A dictionary function. + -- True <=> the class has only one method, so may be + -- implemented with a newtype, so it might be bad + -- to be strict on this dictionary + + +instance Outputable IdDetails where + ppr = pprIdDetails + +pprIdDetails :: IdDetails -> SDoc +pprIdDetails VanillaId = empty +pprIdDetails other = brackets (pp other) + where + pp VanillaId = panic "pprIdDetails" + pp (DataConWorkId _) = ptext (sLit "DataCon") + pp (DataConWrapId _) = ptext (sLit "DataConWrapper") + pp (ClassOpId {}) = ptext (sLit "ClassOp") + pp (PrimOpId _) = ptext (sLit "PrimOp") + pp (FCallId _) = ptext (sLit "ForeignCall") + pp (TickBoxOpId _) = ptext (sLit "TickBoxOp") + pp (DFunId b) = ptext (sLit "DFunId") <> + ppWhen b (ptext (sLit "(newtype)")) + pp (RecSelId { sel_naughty = is_naughty }) + = brackets $ ptext (sLit "RecSel") + <> ppWhen is_naughty (ptext (sLit "(naughty)")) \end{code} @@ -275,60 +294,53 @@ instance Outputable GlobalIdDetails where %* * %************************************************************************ -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. - -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). (@lbvarInfo@ is also a marginal -case. KSW 1999-04). - \begin{code} +-- | An 'IdInfo' gives /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. +-- +-- 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 not contain information about the 'Id''s usage, +-- except for 'demandInfo' and 'lbvarInfo'. data IdInfo = IdInfo { - arityInfo :: !ArityInfo, -- Its arity - specInfo :: SpecInfo, -- Specialisations of this function which exist + arityInfo :: !ArityInfo, -- ^ 'Id' arity + specInfo :: SpecInfo, -- ^ Specialisations of the 'Id's function which exist + -- See Note [Specialisations and RULES in IdInfo] #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 + cprInfo :: CprInfo, -- ^ If the 'Id's function always constructs a product result + demandInfo :: Demand.Demand, -- ^ Whether or not the 'Id' is definitely demanded + strictnessInfo :: StrictnessInfo, -- ^ 'Id' 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 - cafInfo :: CafInfo, -- CAF info - lbvarInfo :: LBVarInfo, -- Info about a lambda-bound variable - inlinePragInfo :: InlinePragInfo, -- Inline pragma - 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 + unfoldingInfo :: Unfolding, -- ^ The 'Id's unfolding + cafInfo :: CafInfo, -- ^ 'Id' CAF info + lbvarInfo :: LBVarInfo, -- ^ Info about a lambda-bound variable, if the 'Id' is one + inlinePragInfo :: InlinePragma, -- ^ Any inline pragma atached to the 'Id' + occInfo :: OccInfo, -- ^ How the 'Id' occurs in the program + + newStrictnessInfo :: Maybe StrictSig, -- ^ Id strictness information. Reason for Maybe: + -- the DmdAnal phase needs to know whether + -- this is the first visit, so it can assign botSig. + -- Other customers want topSig. So @Nothing@ is good. + + newDemandInfo :: Maybe Demand -- ^ Id demand information. Similarly we want to know + -- if there's no known demand yet, for when we are looking + -- for CPR info } +-- | Just evaluate the 'IdInfo' to WHNF seqIdInfo :: IdInfo -> () seqIdInfo (IdInfo {}) = () +-- | Evaluate all the fields of the 'IdInfo' that are generally demanded by the +-- compiler megaSeqIdInfo :: IdInfo -> () megaSeqIdInfo info = seqSpecInfo (specInfo info) `seq` - seqWorker (workerInfo info) `seq` -- Omitting this improves runtimes a little, presumably because -- some unfoldings are not calculated at all @@ -351,19 +363,23 @@ megaSeqIdInfo info Setters \begin{code} -setWorkerInfo info wk = wk `seq` info { workerInfo = wk } +setSpecInfo :: IdInfo -> SpecInfo -> IdInfo setSpecInfo info sp = sp `seq` info { specInfo = sp } +setInlinePragInfo :: IdInfo -> InlinePragma -> IdInfo setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr } +setOccInfo :: IdInfo -> OccInfo -> IdInfo 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 +setUnfoldingInfoLazily :: IdInfo -> Unfolding -> IdInfo 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.) +setUnfoldingInfo :: IdInfo -> Unfolding -> IdInfo setUnfoldingInfo info uf -- We do *not* seq on the unfolding info, For some reason, doing so -- actually increases residency significantly. @@ -374,17 +390,23 @@ setDemandInfo info dd = info { demandInfo = dd } setCprInfo info cp = info { cprInfo = cp } #endif +setArityInfo :: IdInfo -> ArityInfo -> IdInfo setArityInfo info ar = info { arityInfo = ar } +setCafInfo :: IdInfo -> CafInfo -> IdInfo setCafInfo info caf = info { cafInfo = caf } +setLBVarInfo :: IdInfo -> LBVarInfo -> IdInfo setLBVarInfo info lb = {-lb `seq`-} info { lbvarInfo = lb } +setNewDemandInfo :: IdInfo -> Maybe Demand -> IdInfo setNewDemandInfo info dd = dd `seq` info { newDemandInfo = dd } +setNewStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo setNewStrictnessInfo info dd = dd `seq` info { newStrictnessInfo = dd } \end{code} \begin{code} +-- | Basic 'IdInfo' that carries no useful information whatsoever vanillaIdInfo :: IdInfo vanillaIdInfo = IdInfo { @@ -396,15 +418,16 @@ vanillaIdInfo strictnessInfo = NoStrictnessInfo, #endif specInfo = emptySpecInfo, - workerInfo = NoWorker, unfoldingInfo = noUnfolding, lbvarInfo = NoLBVarInfo, - inlinePragInfo = AlwaysActive, + inlinePragInfo = defaultInlinePragma, occInfo = NoOccInfo, newDemandInfo = Nothing, newStrictnessInfo = Nothing } +-- | More informative 'IdInfo' we can use when we know the 'Id' has no CAF references +noCafIdInfo :: IdInfo noCafIdInfo = vanillaIdInfo `setCafInfo` NoCafRefs -- Used for built-in type Ids in MkId. \end{code} @@ -421,19 +444,23 @@ of their arities; so it should not be asking... (but other things besides the code-generator need arity info!) \begin{code} +-- | An 'ArityInfo' of @n@ tells us that 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 arity might increase later in the compilation process, if +-- an extra lambda floats up to the binding site. 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 arity might increase later in the compilation process, if - -- an extra lambda floats up to the binding site. +-- | It is always safe to assume that an 'Id' has an arity of 0 +unknownArity :: Arity unknownArity = 0 :: Arity +ppArityInfo :: Int -> SDoc ppArityInfo 0 = empty -ppArityInfo n = hsep [ptext SLIT("Arity"), int n] +ppArityInfo n = hsep [ptext (sLit "Arity"), int n] \end{code} %************************************************************************ @@ -443,16 +470,16 @@ ppArityInfo n = hsep [ptext SLIT("Arity"), int n] %************************************************************************ \begin{code} -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 +-- | 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 Core inline 'Note' +-- +-- The default 'InlinePragInfo' is 'AlwaysActive', so the info serves +-- entirely as a way to inhibit inlining until we want it +type InlinePragInfo = InlinePragma \end{code} @@ -462,85 +489,60 @@ type InlinePragInfo = Activation %* * %************************************************************************ +Note [Specialisations and RULES in IdInfo] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Generally speaking, a GlobalIdshas an *empty* SpecInfo. All their +RULES are contained in the globally-built rule-base. In principle, +one could attach the to M.f the RULES for M.f that are defined in M. +But we don't do that for instance declarations and so we just treat +them all uniformly. + +The EXCEPTION is PrimOpIds, which do have rules in their IdInfo. That is +jsut for convenience really. + +However, LocalIds may have non-empty SpecInfo. We treat them +differently because: + a) they might be nested, in which case a global table won't work + b) the RULE might mention free variables, which we use to keep things alive + +In TidyPgm, when the LocalId becomes a GlobalId, its RULES are stripped off +and put in the global list. + \begin{code} --- CoreRules is used only in an idSpecialisation (move to IdInfo?) +-- | Records the specializations of this 'Id' that we know about +-- in the form of rewrite 'CoreRule's that target them data SpecInfo - = SpecInfo [CoreRule] VarSet -- Locally-defined free vars of RHSs - + = SpecInfo + [CoreRule] + VarSet -- Locally-defined free vars of *both* LHS and RHS + -- of rules. I don't think it needs to include the + -- ru_fn though. + -- Note [Rule dependency info] in OccurAnal + +-- | Assume that no specilizations exist: always safe emptySpecInfo :: SpecInfo emptySpecInfo = SpecInfo [] emptyVarSet isEmptySpecInfo :: SpecInfo -> Bool isEmptySpecInfo (SpecInfo rs _) = null rs +-- | Retrieve the locally-defined free variables of both the left and +-- right hand sides of the specialization rules 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} +-- | Change the name of the function the rule is keyed on on all of the 'CoreRule's +setSpecInfoHead :: Name -> SpecInfo -> SpecInfo +setSpecInfoHead fn (SpecInfo rules fvs) + = SpecInfo (map (setRuleIdName fn) rules) fvs - -%************************************************************************ -%* * -\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 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. See notes above. - -seqWorker :: WorkerInfo -> () -seqWorker (HasWorker id a) = id `seq` a `seq` () -seqWorker NoWorker = () - -ppWorkerInfo NoWorker = empty -ppWorkerInfo (HasWorker wk_id _) = ptext SLIT("Worker") <+> ppr wk_id - -workerExists :: WorkerInfo -> Bool -workerExists NoWorker = False -workerExists (HasWorker _ _) = True - -workerId :: WorkerInfo -> Id -workerId (HasWorker id _) = id - -wrapperArity :: WorkerInfo -> Arity -wrapperArity (HasWorker _ a) = a +seqSpecInfo :: SpecInfo -> () +seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs \end{code} - %************************************************************************ %* * \subsection[CG-IdInfo]{Code generator-related information} @@ -550,23 +552,35 @@ wrapperArity (HasWorker _ a) = a \begin{code} -- CafInfo is used to build Static Reference Tables (see simplStg/SRT.lhs). +-- | Records whether an 'Id' makes Constant Applicative Form references data CafInfo - = MayHaveCafRefs -- either: - -- (1) A function or static constructor - -- that refers to one or more CAFs, - -- (2) A real live CAF - - | NoCafRefs -- A function or static constructor + = MayHaveCafRefs -- ^ Indicates that the 'Id' is for either: + -- + -- 1. A function or static constructor + -- that refers to one or more CAFs, or + -- + -- 2. A real live CAF + + | NoCafRefs -- ^ A function or static constructor -- that refers to no CAFs. + deriving (Eq, Ord) -vanillaCafInfo = MayHaveCafRefs -- Definitely safe +-- | Assumes that the 'Id' has CAF references: definitely safe +vanillaCafInfo :: CafInfo +vanillaCafInfo = MayHaveCafRefs +mayHaveCafRefs :: CafInfo -> Bool mayHaveCafRefs MayHaveCafRefs = True mayHaveCafRefs _ = False +seqCaf :: CafInfo -> () seqCaf c = c `seq` () -ppCafInfo NoCafRefs = ptext SLIT("NoCafRefs") +instance Outputable CafInfo where + ppr = ppCafInfo + +ppCafInfo :: CafInfo -> SDoc +ppCafInfo NoCafRefs = ptext (sLit "NoCafRefs") ppCafInfo MayHaveCafRefs = empty \end{code} @@ -576,45 +590,44 @@ ppCafInfo MayHaveCafRefs = empty %* * %************************************************************************ -If the @Id@ is a function then it may have CPR info. A CPR analysis -phase detects whether: - -\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} #ifdef OLD_STRICTNESS +-- | If the @Id@ is a function then it may have Constructed Product Result +-- (CPR) info. A CPR analysis phase detects whether: +-- +-- 1. 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. +-- +-- 2. 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. +-- +-- 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. data CprInfo - = NoCPRInfo - | ReturnsCPR -- Yes, this function returns a constructed product + = NoCPRInfo -- ^ No, this function does not return a constructed product + | 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 + -- 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 +-- | It's always safe to assume that an 'Id' does not have the CPR property +noCprInfo :: CprInt +noCprInfo = NoCPRInfo + seqCpr :: CprInfo -> () seqCpr ReturnsCPR = () seqCpr NoCPRInfo = () -noCprInfo = NoCPRInfo - ppCprInfo NoCPRInfo = empty -ppCprInfo ReturnsCPR = ptext SLIT("__M") +ppCprInfo ReturnsCPR = ptext (sLit "__M") instance Outputable CprInfo where ppr = ppCprInfo @@ -624,36 +637,37 @@ instance Show CprInfo where #endif \end{code} - %************************************************************************ %* * \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. 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 is applied at most once). - -seqLBVar l = l `seq` () -\end{code} +-- | If the 'Id' is a lambda-bound variable then it may have lambda-bound +-- variable info. Sometimes we know whether the lambda binding this variable +-- 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. +data LBVarInfo = NoLBVarInfo -- ^ No information + | IsOneShotLambda -- ^ The lambda is applied at most once). + +-- | It is always safe to assume that an 'Id' has no lambda-bound variable information +noLBVarInfo :: LBVarInfo +noLBVarInfo = NoLBVarInfo -\begin{code} +hasNoLBVarInfo :: LBVarInfo -> Bool hasNoLBVarInfo NoLBVarInfo = True hasNoLBVarInfo IsOneShotLambda = False -noLBVarInfo = NoLBVarInfo +seqLBVar :: LBVarInfo -> () +seqLBVar l = l `seq` () +pprLBVarInfo :: LBVarInfo -> SDoc pprLBVarInfo NoLBVarInfo = empty -pprLBVarInfo IsOneShotLambda = ptext SLIT("OneShot") +pprLBVarInfo IsOneShotLambda = ptext (sLit "OneShot") instance Outputable LBVarInfo where ppr = pprLBVarInfo @@ -669,10 +683,12 @@ instance Show LBVarInfo where %* * %************************************************************************ -@zapLamInfo@ is used for lambda binders that turn out to to be -part of an unsaturated lambda - \begin{code} +-- | This is used to remove information on lambda binders that we have +-- setup as part of a lambda group, assuming they will be applied all at once, +-- but turn out to be part of an unsaturated lambda as in e.g: +-- +-- > (\x1. \x2. e) arg1 zapLamInfo :: IdInfo -> Maybe IdInfo zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand}) | is_safe_occ occ && is_safe_dmd demand @@ -683,17 +699,18 @@ zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand}) -- 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 (OneOcc in_lam _ _) = in_lam - is_safe_occ other = True + is_safe_occ _other = True safe_occ = case occ of OneOcc _ once int_cxt -> OneOcc insideLam once int_cxt - other -> occ + _other -> occ is_safe_dmd Nothing = True is_safe_dmd (Just dmd) = not (isStrictDmd dmd) \end{code} \begin{code} +-- | Remove demand info on the 'IdInfo' if it is present, otherwise return @Nothing@ zapDemandInfo :: IdInfo -> Maybe IdInfo zapDemandInfo info@(IdInfo {newDemandInfo = dmd}) | isJust dmd = Just (info {newDemandInfo = Nothing}) @@ -702,10 +719,13 @@ zapDemandInfo info@(IdInfo {newDemandInfo = dmd}) \begin{code} zapFragileInfo :: IdInfo -> Maybe IdInfo --- Zap info that depends on free variables -zapFragileInfo info = Just (info `setSpecInfo` emptySpecInfo - `setWorkerInfo` NoWorker - `setUnfoldingInfo` NoUnfolding) +-- ^ Zap info that depends on free variables +zapFragileInfo info + = Just (info `setSpecInfo` emptySpecInfo + `setUnfoldingInfo` noUnfolding + `setOccInfo` if isFragileOcc occ then NoOccInfo else occ) + where + occ = occInfo info \end{code} %************************************************************************ @@ -717,10 +737,10 @@ zapFragileInfo info = Just (info `setSpecInfo` emptySpecInfo \begin{code} type TickBoxId = Int +-- | Tick box for Hpc-style coverage data TickBoxOp - = TickBox Module !TickBoxId -- ^Tick box for Hpc-style coverage, - -- type = State# Void# + = TickBox Module {-# UNPACK #-} !TickBoxId instance Outputable TickBoxOp where - ppr (TickBox mod n) = ptext SLIT("tick") <+> ppr (mod,n) + ppr (TickBox mod n) = ptext (sLit "tick") <+> ppr (mod,n) \end{code}