\begin{code}
module IdInfo (
- GlobalIdDetails(..), notGlobalId, -- Not abstract
+ -- * The IdDetails type
+ IdDetails(..), pprIdDetails, coVarDetails,
+ -- * 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,
-
- -- 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(..),
+ emptySpecInfo,
+ 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 Var
+import Name
import VarSet
import BasicTypes
import DataCon
import TyCon
import ForeignCall
-import NewDemand
+import Demand
import Outputable
import Module
+import FastString
import Data.Maybe
-#ifdef OLD_STRICTNESS
-import Name
-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}
--- setAllStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo
--- Set old and new strictness info
-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 Nothing = ()
-seqNewStrictnessInfo (Just ty) = seqStrictSig ty
-
-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 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
- , 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 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
+
+coVarDetails :: IdDetails
+coVarDetails = VanillaId
+
+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}
%* *
%************************************************************************
-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 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.
- = 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 }
+setCafInfo :: IdInfo -> CafInfo -> IdInfo
setCafInfo info caf = info { cafInfo = caf }
+setLBVarInfo :: IdInfo -> LBVarInfo -> IdInfo
setLBVarInfo info lb = {-lb `seq`-} info { lbvarInfo = lb }
-setNewDemandInfo info dd = dd `seq` info { newDemandInfo = dd }
-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.
\end{code}
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}
%************************************************************************
%************************************************************************
\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}
%************************************************************************
%* *
- SpecInfo
+ Strictness
%* *
%************************************************************************
\begin{code}
--- CoreRules is used only in an idSpecialisation (move to IdInfo?)
-data SpecInfo
- = SpecInfo [CoreRule] VarSet -- Locally-defined free vars of RHSs
-
-emptySpecInfo :: SpecInfo
-emptySpecInfo = SpecInfo [] emptyVarSet
-
-isEmptySpecInfo :: SpecInfo -> Bool
-isEmptySpecInfo (SpecInfo rs _) = null rs
-
-specInfoFreeVars :: SpecInfo -> VarSet
-specInfoFreeVars (SpecInfo _ fvs) = fvs
-
-specInfoRules :: SpecInfo -> [CoreRule]
-specInfoRules (SpecInfo rules _) = rules
-
-seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs
+pprStrictness :: Maybe StrictSig -> SDoc
+pprStrictness Nothing = empty
+pprStrictness (Just sig) = ppr sig
\end{code}
%************************************************************************
%* *
-\subsection[worker-IdInfo]{Worker info about an @Id@}
+ SpecInfo
%* *
%************************************************************************
-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.
+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.
-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.
+The EXCEPTION is PrimOpIds, which do have rules in their IdInfo. That is
+jsut for convenience really.
-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).
+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
-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".
+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]
+ 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
-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 = ()
+isEmptySpecInfo :: SpecInfo -> Bool
+isEmptySpecInfo (SpecInfo rs _) = null rs
-ppWorkerInfo NoWorker = empty
-ppWorkerInfo (HasWorker wk_id _) = ptext SLIT("Worker") <+> ppr wk_id
+-- | 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
-workerExists :: WorkerInfo -> Bool
-workerExists NoWorker = False
-workerExists (HasWorker _ _) = True
+specInfoRules :: SpecInfo -> [CoreRule]
+specInfoRules (SpecInfo rules _) = rules
-workerId :: WorkerInfo -> Id
-workerId (HasWorker id _) = id
+-- | 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
-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}
\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")
-ppCafInfo MayHaveCafRefs = empty
-\end{code}
+instance Outputable CafInfo where
+ ppr = ppCafInfo
-%************************************************************************
-%* *
-\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
-
-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 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
%* *
%************************************************************************
-@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
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})
+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
-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` zapFragileOcc occ)
+ where
+ occ = occInfo info
\end{code}
%************************************************************************
\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}
projects / ghc-hetmet.git / blobdiff