\begin{code}
module IdInfo (
- -- * The GlobalIdDetails type
- GlobalIdDetails(..), notGlobalId, -- Not abstract
+ -- * The IdDetails type
+ IdDetails(..), pprIdDetails,
-- * The IdInfo type
IdInfo, -- Abstract
cprInfoFromNewStrictness,
#endif
+ -- ** The WorkerInfo type
+ WorkerInfo(..),
+ workerExists, wrapperArity, workerId,
+ workerInfo, setWorkerInfo, ppWorkerInfo,
+
-- ** Unfolding Info
unfoldingInfo, setUnfoldingInfo, setUnfoldingInfoLazily,
import Class
import PrimOp
import Name
+import Var
import VarSet
import BasicTypes
import DataCon
`setArityInfo`,
`setInlinePragInfo`,
`setUnfoldingInfo`,
+ `setWorkerInfo`,
`setLBVarInfo`,
`setOccInfo`,
`setCafInfo`,
%************************************************************************
%* *
-\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/
| 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}
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:
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
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 }
strictnessInfo = NoStrictnessInfo,
#endif
specInfo = emptySpecInfo,
+ workerInfo = NoWorker,
unfoldingInfo = noUnfolding,
lbvarInfo = NoLBVarInfo,
- inlinePragInfo = AlwaysActive,
+ inlinePragInfo = defaultInlinePragma,
occInfo = NoOccInfo,
newDemandInfo = Nothing,
newStrictnessInfo = Nothing
--
-- 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}
%************************************************************************
%* *
+\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}
%* *
%************************************************************************
-- ^ 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
projects / ghc-hetmet.git / blobdiff