X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FIdInfo.lhs;h=fb18c810859277ec5e714be478aaa8d738a8a7ef;hb=388e3356f71daffa62f1d4157e1e07e4c68f218a;hp=fca1abd1cfac962b49d07fef1f55f561bfc462d3;hpb=d95ce839533391e7118257537044f01cbb1d6694;p=ghc-hetmet.git diff --git a/compiler/basicTypes/IdInfo.lhs b/compiler/basicTypes/IdInfo.lhs index fca1abd..fb18c81 100644 --- a/compiler/basicTypes/IdInfo.lhs +++ b/compiler/basicTypes/IdInfo.lhs @@ -9,8 +9,8 @@ Haskell. [WDP 94/11]) \begin{code} module IdInfo ( - -- * The GlobalIdDetails type - GlobalIdDetails(..), notGlobalId, -- Not abstract + -- * The IdDetails type + IdDetails(..), pprIdDetails, -- * The IdInfo type IdInfo, -- Abstract @@ -49,6 +49,11 @@ module IdInfo ( cprInfoFromNewStrictness, #endif + -- ** The WorkerInfo type + WorkerInfo(..), + workerExists, wrapperArity, workerId, + workerInfo, setWorkerInfo, ppWorkerInfo, + -- ** Unfolding Info unfoldingInfo, setUnfoldingInfo, setUnfoldingInfoLazily, @@ -89,6 +94,7 @@ import CoreSyn ( CoreRule, setRuleIdName, seqRules, Unfolding, noUnfolding ) import Class import PrimOp import Name +import Var import VarSet import BasicTypes import DataCon @@ -113,6 +119,7 @@ infixl 1 `setSpecInfo`, `setArityInfo`, `setInlinePragInfo`, `setUnfoldingInfo`, + `setWorkerInfo`, `setLBVarInfo`, `setOccInfo`, `setCafInfo`, @@ -227,31 +234,23 @@ 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} --- | Information pertaining to global 'Id's. See "Var#globalvslocal" for the distinction --- between global and local in this context -data GlobalIdDetails - = VanillaGlobal -- ^ The 'Id' is imported from elsewhere or is a default method 'Id' +-- | The 'IdDetails' of an 'Id' give stable, and necessary, +-- information about the Id. +data IdDetails + = VanillaId -- | The 'Id' for a record selector - | RecordSelId + | RecSelId { sel_tycon :: TyCon -- ^ For a data type family, this is the /instance/ 'TyCon' -- not the family 'TyCon' - , sel_label :: FieldLabel , 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] - -- with MkId.mkRecordSelectorId + -- 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/ @@ -268,22 +267,28 @@ data GlobalIdDetails | TickBoxOpId TickBoxOp -- ^ The 'Id' is for a HPC tick box (both traditional and binary) - | NotGlobalId -- ^ Used as a convenient extra return value from 'globalIdDetails' - --- | An entirely unhelpful '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]") + | DFunId -- ^ A dictionary function. We don't use this in an essential way, + -- currently, but it's kind of nice that we can keep track of + -- which Ids are DFuns, across module boundaries too + + +instance Outputable IdDetails where + ppr = pprIdDetails + +pprIdDetails :: IdDetails -> SDoc +pprIdDetails VanillaId = empty +pprIdDetails (DataConWorkId _) = ptext (sLit "[DataCon]") +pprIdDetails (DataConWrapId _) = ptext (sLit "[DataConWrapper]") +pprIdDetails (ClassOpId _) = ptext (sLit "[ClassOp]") +pprIdDetails (PrimOpId _) = ptext (sLit "[PrimOp]") +pprIdDetails (FCallId _) = ptext (sLit "[ForeignCall]") +pprIdDetails (TickBoxOpId _) = ptext (sLit "[TickBoxOp]") +pprIdDetails DFunId = ptext (sLit "[DFunId]") +pprIdDetails (RecSelId { sel_naughty = is_naughty }) + = brackets $ ptext (sLit "RecSel") <> pp_naughty + where + pp_naughty | is_naughty = ptext (sLit "(naughty)") + | otherwise = empty \end{code} @@ -314,10 +319,19 @@ data IdInfo 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'. + -- However, when the module is imported by others, the + -- '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, -- ^ The 'Id's unfolding cafInfo :: CafInfo, -- ^ 'Id' CAF info lbvarInfo :: LBVarInfo, -- ^ Info about a lambda-bound variable, if the 'Id' is one - inlinePragInfo :: InlinePragInfo, -- ^ Any inline pragma atached to the 'Id' + 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: @@ -339,6 +353,7 @@ seqIdInfo (IdInfo {}) = () 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 @@ -361,9 +376,11 @@ megaSeqIdInfo info 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 } @@ -416,9 +433,10 @@ vanillaIdInfo strictnessInfo = NoStrictnessInfo, #endif specInfo = emptySpecInfo, + workerInfo = NoWorker, unfoldingInfo = noUnfolding, lbvarInfo = NoLBVarInfo, - inlinePragInfo = AlwaysActive, + inlinePragInfo = defaultInlinePragma, occInfo = NoOccInfo, newDemandInfo = Nothing, newStrictnessInfo = Nothing @@ -477,7 +495,7 @@ ppArityInfo n = hsep [ptext (sLit "Arity"), int n] -- -- The default 'InlinePragInfo' is 'AlwaysActive', so the info serves -- entirely as a way to inhibit inlining until we want it -type InlinePragInfo = Activation +type InlinePragInfo = InlinePragma \end{code} @@ -524,6 +542,67 @@ seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs %************************************************************************ %* * +\subsection[worker-IdInfo]{Worker info about an @Id@} +%* * +%************************************************************************ + +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} + +-- | If this Id has a worker then we store a reference to it. Worker +-- functions are generated by the worker\/wrapper pass, using information +-- information from strictness analysis. +data WorkerInfo = NoWorker -- ^ No known worker function + | HasWorker Id Arity -- ^ The 'Arity' is the arity of the /wrapper/ at the moment of the + -- worker\/wrapper split, which may be different from the current 'Id' 'Aritiy' + +seqWorker :: WorkerInfo -> () +seqWorker (HasWorker id a) = id `seq` a `seq` () +seqWorker NoWorker = () + +ppWorkerInfo :: WorkerInfo -> SDoc +ppWorkerInfo NoWorker = empty +ppWorkerInfo (HasWorker wk_id _) = ptext (sLit "Worker") <+> ppr wk_id + +workerExists :: WorkerInfo -> Bool +workerExists NoWorker = False +workerExists (HasWorker _ _) = True + +-- | The 'Id' of the worker function if it exists, or a panic otherwise +workerId :: WorkerInfo -> Id +workerId (HasWorker id _) = id +workerId NoWorker = panic "workerId: NoWorker" + +-- | The 'Arity' of the worker function at the time of the split if it exists, or a panic otherwise +wrapperArity :: WorkerInfo -> Arity +wrapperArity (HasWorker _ a) = a +wrapperArity NoWorker = panic "wrapperArity: NoWorker" +\end{code} + + +%************************************************************************ +%* * \subsection[CG-IdInfo]{Code generator-related information} %* * %************************************************************************ @@ -698,6 +777,7 @@ zapFragileInfo :: IdInfo -> Maybe IdInfo -- ^ 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) where