X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FIdInfo.lhs;h=1c01ba4355612dded016d6665f011bead6a8da01;hp=dbbaeacb490bec227658165a7aa79c0b88efd3bb;hb=a3bab0506498db41853543558c52a4fda0d183af;hpb=601c7b4c12196950683c27f1cc796e40ac6fc15e diff --git a/compiler/basicTypes/IdInfo.lhs b/compiler/basicTypes/IdInfo.lhs index dbbaeac..1c01ba4 100644 --- a/compiler/basicTypes/IdInfo.lhs +++ b/compiler/basicTypes/IdInfo.lhs @@ -9,269 +9,157 @@ 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 - newStrictnessInfo, setNewStrictnessInfo, - newDemandInfo, setNewDemandInfo, pprNewStrictness, - setAllStrictnessInfo, + -- ** Demand and strictness Info + strictnessInfo, setStrictnessInfo, + demandInfo, setDemandInfo, pprStrictness, -#ifdef OLD_STRICTNESS - -- Strictness; imported from Demand - StrictnessInfo(..), - mkStrictnessInfo, noStrictnessInfo, - ppStrictnessInfo,isBottomingStrictness, -#endif - - -- Worker - WorkerInfo(..), workerExists, wrapperArity, workerId, - workerInfo, setWorkerInfo, ppWorkerInfo, - - -- Unfolding + -- ** Unfolding Info unfoldingInfo, setUnfoldingInfo, setUnfoldingInfoLazily, -#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, - - -- Occurrence info - OccInfo(..), isFragileOcc, isDeadOcc, isLoopBreaker, - InsideLam, OneBranch, insideLam, notInsideLam, oneBranch, notOneBranch, - occInfo, setOccInfo, - - -- Specialisation - SpecInfo(..), specInfo, setSpecInfo, isEmptySpecInfo, - specInfoFreeVars, specInfoRules, seqSpecInfo, setSpecInfoHead, - - -- CAF info - CafInfo(..), cafInfo, ppCafInfo, setCafInfo, mayHaveCafRefs, - - -- Lambda-bound variable info - LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo, hasNoLBVarInfo, - - -- Tick-box info + -- ** The InlinePragInfo type + InlinePragInfo, + inlinePragInfo, setInlinePragInfo, + + -- ** The OccInfo type + OccInfo(..), + 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 + import Class import PrimOp import Name -import Var import VarSet import BasicTypes import DataCon import TyCon import ForeignCall -import NewDemand +import Demand import Outputable import Module -import Pretty (Doc) +import FastString import Data.Maybe -#ifdef OLD_STRICTNESS -import Demand -import qualified Demand -import Util -import Data.List -#endif - -- infixl so you can say (id `set` a `set` b) infixl 1 `setSpecInfo`, `setArityInfo`, `setInlinePragInfo`, `setUnfoldingInfo`, - `setWorkerInfo`, `setLBVarInfo`, `setOccInfo`, `setCafInfo`, - `setNewStrictnessInfo`, - `setAllStrictnessInfo`, - `setNewDemandInfo` -#ifdef OLD_STRICTNESS - , `setCprInfo` - , `setDemandInfo` - , `setStrictnessInfo` -#endif + `setStrictnessInfo`, + `setDemandInfo` \end{code} %************************************************************************ %* * -\subsection{New strictness info} + IdDetails %* * %************************************************************************ -To be removed later - -\begin{code} --- Set old and new strictness info -setAllStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo -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 :: Maybe StrictSig -> () -seqNewStrictnessInfo Nothing = () -seqNewStrictnessInfo (Just ty) = seqStrictSig ty - -pprNewStrictness :: Maybe StrictSig -> PprStyle -> Doc -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 :: Maybe Demand -> () -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 -- For a data type family, this is the *instance* TyCon - -- not the family 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 :: 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 Int Bool -- ^ A dictionary function. + -- Int = the number of "silent" arguments to the dfun + -- e.g. class D a => C a where ... + -- instance C a => C [a] + -- has is_silent = 1, because the dfun + -- has type dfun :: (D a, C a) => C [a] + -- See the DFun Superclass Invariant in TcInstDcls + -- + -- Bool = 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 ns nt) = ptext (sLit "DFunId") + <> ppWhen (ns /= 0) (brackets (int ns)) + <> ppWhen nt (ptext (sLit "(nt)")) + pp (RecSelId { sel_naughty = is_naughty }) + = brackets $ ptext (sLit "RecSel") + <> ppWhen is_naughty (ptext (sLit "(naughty)")) \end{code} @@ -281,93 +169,78 @@ 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 -#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 - 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 + arityInfo :: !ArityInfo, -- ^ 'Id' arity + specInfo :: SpecInfo, -- ^ Specialisations of the 'Id's function which exist + -- See Note [Specialisations and RULES in IdInfo] + 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 + + strictnessInfo :: 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. + + demandInfo :: 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 -- 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 + seqDemandInfo (demandInfo info) `seq` + seqStrictnessInfo (strictnessInfo info) `seq` seqCaf (cafInfo info) `seq` seqLBVar (lbvarInfo info) `seq` seqOccInfo (occInfo info) + +seqStrictnessInfo :: Maybe StrictSig -> () +seqStrictnessInfo Nothing = () +seqStrictnessInfo (Just ty) = seqStrictSig ty + +seqDemandInfo :: Maybe Demand -> () +seqDemandInfo Nothing = () +seqDemandInfo (Just dmd) = seqDemand dmd \end{code} Setters \begin{code} -setWorkerInfo :: IdInfo -> WorkerInfo -> IdInfo -setWorkerInfo info wk = wk `seq` info { workerInfo = wk } setSpecInfo :: IdInfo -> SpecInfo -> IdInfo setSpecInfo info sp = sp `seq` info { specInfo = sp } -setInlinePragInfo :: IdInfo -> InlinePragInfo -> IdInfo +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 @@ -377,14 +250,11 @@ setUnfoldingInfoLazily info uf -- Lazy variant to avoid looking at the setUnfoldingInfo :: IdInfo -> Unfolding -> IdInfo setUnfoldingInfo info uf - -- We do *not* seq on the unfolding info, For some reason, doing so - -- actually increases residency significantly. - = info { unfoldingInfo = uf } - -#ifdef OLD_STRICTNESS -setDemandInfo info dd = info { demandInfo = dd } -setCprInfo info cp = info { cprInfo = cp } -#endif + = -- We don't seq the unfolding, as we generate intermediate + -- unfoldings which are just thrown away, so evaluating them is a + -- waste of time. + -- seqUnfolding uf `seq` + info { unfoldingInfo = uf } setArityInfo :: IdInfo -> ArityInfo -> IdInfo setArityInfo info ar = info { arityInfo = ar } @@ -394,34 +264,31 @@ 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 } +setDemandInfo :: IdInfo -> Maybe Demand -> IdInfo +setDemandInfo info dd = dd `seq` info { demandInfo = dd } + +setStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo +setStrictnessInfo info dd = dd `seq` info { strictnessInfo = dd } \end{code} \begin{code} +-- | Basic 'IdInfo' that carries no useful information whatsoever vanillaIdInfo :: IdInfo 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, + inlinePragInfo = defaultInlinePragma, occInfo = NoOccInfo, - newDemandInfo = Nothing, - newStrictnessInfo = Nothing + demandInfo = Nothing, + strictnessInfo = 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. @@ -439,21 +306,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 -> PprStyle -> Doc +ppArityInfo :: Int -> SDoc ppArityInfo 0 = empty -ppArityInfo n = hsep [ptext SLIT("Arity"), int n] +ppArityInfo n = hsep [ptext (sLit "Arity"), int n] \end{code} %************************************************************************ @@ -463,16 +332,29 @@ 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} + + +%************************************************************************ +%* * + Strictness +%* * +%************************************************************************ + +\begin{code} +pprStrictness :: Maybe StrictSig -> SDoc +pprStrictness Nothing = empty +pprStrictness (Just sig) = ppr sig \end{code} @@ -482,7 +364,28 @@ 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} +-- | Records the specializations of this 'Id' that we know about +-- in the form of rewrite 'CoreRule's that target them data SpecInfo = SpecInfo [CoreRule] @@ -491,91 +394,30 @@ data SpecInfo -- 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 +-- | 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 set_head rules) fvs - where - set_head rule = rule { ru_fn = fn } + = SpecInfo (map (setRuleIdName fn) rules) fvs seqSpecInfo :: SpecInfo -> () seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs \end{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 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 :: WorkerInfo -> PprStyle -> Doc -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 -workerId NoWorker = panic "workerId: NoWorker" - -wrapperArity :: WorkerInfo -> Arity -wrapperArity (HasWorker _ a) = a -wrapperArity NoWorker = panic "wrapperArity: NoWorker" -\end{code} - - %************************************************************************ %* * \subsection[CG-IdInfo]{Code generator-related information} @@ -585,17 +427,22 @@ wrapperArity NoWorker = panic "wrapperArity: NoWorker" \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) +-- | Assumes that the 'Id' has CAF references: definitely safe vanillaCafInfo :: CafInfo -vanillaCafInfo = MayHaveCafRefs -- Definitely safe +vanillaCafInfo = MayHaveCafRefs mayHaveCafRefs :: CafInfo -> Bool mayHaveCafRefs MayHaveCafRefs = True @@ -604,99 +451,45 @@ mayHaveCafRefs _ = False seqCaf :: CafInfo -> () seqCaf c = c `seq` () -ppCafInfo :: CafInfo -> PprStyle -> Doc -ppCafInfo NoCafRefs = ptext SLIT("NoCafRefs") -ppCafInfo MayHaveCafRefs = empty -\end{code} - -%************************************************************************ -%* * -\subsection[cpr-IdInfo]{Constructed Product Result info about an @Id@} -%* * -%************************************************************************ - -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 -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 +instance Outputable CafInfo where + ppr = ppCafInfo -seqCpr :: CprInfo -> () -seqCpr ReturnsCPR = () -seqCpr NoCPRInfo = () - -noCprInfo = NoCPRInfo - -ppCprInfo NoCPRInfo = empty -ppCprInfo ReturnsCPR = ptext SLIT("__M") - -instance Outputable CprInfo where - ppr = ppCprInfo - -instance Show CprInfo where - showsPrec p c = showsPrecSDoc p (ppr c) -#endif +ppCafInfo :: CafInfo -> SDoc +ppCafInfo NoCafRefs = ptext (sLit "NoCafRefs") +ppCafInfo MayHaveCafRefs = empty \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 :: LBVarInfo -> () -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 :: LBVarInfo -noLBVarInfo = NoLBVarInfo +seqLBVar :: LBVarInfo -> () +seqLBVar l = l `seq` () -pprLBVarInfo :: LBVarInfo -> PprStyle -> Doc +pprLBVarInfo :: LBVarInfo -> SDoc pprLBVarInfo NoLBVarInfo = empty -pprLBVarInfo IsOneShotLambda = ptext SLIT("OneShot") +pprLBVarInfo IsOneShotLambda = ptext (sLit "OneShot") instance Outputable LBVarInfo where ppr = pprLBVarInfo @@ -712,16 +505,18 @@ 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}) +zapLamInfo info@(IdInfo {occInfo = occ, demandInfo = demand}) | is_safe_occ occ && is_safe_dmd demand = Nothing | otherwise - = Just (info {occInfo = safe_occ, newDemandInfo = Nothing}) + = Just (info {occInfo = safe_occ, demandInfo = 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 @@ -737,20 +532,20 @@ zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand}) \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}) +zapDemandInfo info@(IdInfo {demandInfo = dmd}) + | isJust dmd = Just (info {demandInfo = Nothing}) | otherwise = Nothing \end{code} \begin{code} zapFragileInfo :: IdInfo -> Maybe IdInfo --- Zap info that depends on free variables +-- ^ Zap info that depends on free variables zapFragileInfo info = Just (info `setSpecInfo` emptySpecInfo - `setWorkerInfo` NoWorker - `setUnfoldingInfo` NoUnfolding - `setOccInfo` if isFragileOcc occ then NoOccInfo else occ) + `setUnfoldingInfo` noUnfolding + `setOccInfo` zapFragileOcc occ) where occ = occInfo info \end{code} @@ -764,10 +559,10 @@ zapFragileInfo info \begin{code} type TickBoxId = Int +-- | Tick box for Hpc-style coverage data TickBoxOp = TickBox Module {-# UNPACK #-} !TickBoxId - -- ^Tick box for Hpc-style coverage 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}