occInfo, setOccInfo,
-- Specialisation
- specInfo, setSpecInfo,
+ SpecInfo(..), specInfo, setSpecInfo, isEmptySpecInfo,
+ specInfoFreeVars, specInfoRules, seqSpecInfo,
-- CAF info
CafInfo(..), cafInfo, ppCafInfo, setCafInfo, mayHaveCafRefs,
import Class ( Class )
import PrimOp ( PrimOp )
import Var ( Id )
+import VarSet ( VarSet, emptyVarSet, seqVarSet )
import BasicTypes ( OccInfo(..), isFragileOcc, isDeadOcc, seqOccInfo, isLoopBreaker,
InsideLam, insideLam, notInsideLam,
OneBranch, oneBranch, notOneBranch,
data GlobalIdDetails
= VanillaGlobal -- Imported from elsewhere, a default method Id.
- | RecordSelId TyCon FieldLabel -- The Id for a record selector
+ | 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 only reasons we need to know is so that
- -- a) we can suppress printing a definition in the interface file
- -- b) when typechecking a pattern we can get from the
- -- Id back to the data con]
+ -- 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
ppr (ClassOpId _) = ptext SLIT("[ClassOp]")
ppr (PrimOpId _) = ptext SLIT("[PrimOp]")
ppr (FCallId _) = ptext SLIT("[ForeignCall]")
- ppr (RecordSelId _ _) = ptext SLIT("[RecSel]")
+ ppr (RecordSelId {}) = ptext SLIT("[RecSel]")
\end{code}
data IdInfo
= IdInfo {
arityInfo :: !ArityInfo, -- Its arity
- specInfo :: CoreRules, -- Specialisations of this function which exist
+ 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
megaSeqIdInfo :: IdInfo -> ()
megaSeqIdInfo info
- = seqRules (specInfo info) `seq`
+ = seqSpecInfo (specInfo info) `seq`
seqWorker (workerInfo info) `seq`
-- Omitting this improves runtimes a little, presumably because
demandInfo = wwLazy,
strictnessInfo = NoStrictnessInfo,
#endif
- specInfo = emptyCoreRules,
+ specInfo = emptySpecInfo,
workerInfo = NoWorker,
unfoldingInfo = noUnfolding,
lbvarInfo = NoLBVarInfo,
--
-- 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
+\end{code}
+
+
+%************************************************************************
+%* *
+ SpecInfo
+%* *
+%************************************************************************
+
+\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
\end{code}
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 once) = in_lam
- is_safe_occ other = True
+ is_safe_occ (OneOcc in_lam _ _) = in_lam
+ is_safe_occ other = True
safe_occ = case occ of
- OneOcc _ once -> OneOcc insideLam once
- other -> occ
+ OneOcc _ once int_cxt -> OneOcc insideLam once int_cxt
+ other -> occ
is_safe_dmd Nothing = True
is_safe_dmd (Just dmd) = not (isStrictDmd dmd)