arityInfo, setArityInfo, ppArityInfo,
-- ** Demand and strictness Info
- newStrictnessInfo, setNewStrictnessInfo,
- newDemandInfo, setNewDemandInfo, pprNewStrictness,
- setAllStrictnessInfo,
-
-#ifdef OLD_STRICTNESS
- -- ** Old strictness Info
- StrictnessInfo(..),
- mkStrictnessInfo, noStrictnessInfo,
- ppStrictnessInfo, isBottomingStrictness,
- strictnessInfo, setStrictnessInfo,
-
- oldStrictnessFromNew, newStrictnessFromOld,
-
- -- ** Old demand Info
- demandInfo, setDemandInfo,
- oldDemand, newDemand,
-
- -- ** Old Constructed Product Result Info
- CprInfo(..),
- cprInfo, setCprInfo, ppCprInfo, noCprInfo,
- cprInfoFromNewStrictness,
-#endif
-
- -- ** The WorkerInfo type
- WorkerInfo(..),
- workerExists, wrapperArity, workerId,
- workerInfo, setWorkerInfo, ppWorkerInfo,
+ strictnessInfo, setStrictnessInfo,
+ demandInfo, setDemandInfo, pprStrictness,
-- ** Unfolding Info
unfoldingInfo, setUnfoldingInfo, setUnfoldingInfoLazily,
-- ** The OccInfo type
OccInfo(..),
- isFragileOcc, isDeadOcc, isLoopBreaker,
+ isDeadOcc, isLoopBreaker,
occInfo, setOccInfo,
InsideLam, OneBranch,
TickBoxOp(..), TickBoxId,
) where
-import CoreSyn ( CoreRule, setRuleIdName, seqRules, Unfolding, noUnfolding )
+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 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}
-%* *
-%************************************************************************
-
-To be removed later
-
-\begin{code}
--- | Set old and new strictness information together
-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 -> SDoc
-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}
-
-
-%************************************************************************
-%* *
IdDetails
%* *
%************************************************************************
-- b) when desugaring a RecordCon we can get
-- from the Id back to the data con]
- | ClassOpId Class -- ^ The 'Id' is an operation of a class
+ | 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 -- ^ 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
-
+ | 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 (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
+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}
= IdInfo {
arityInfo :: !ArityInfo, -- ^ 'Id' arity
specInfo :: SpecInfo, -- ^ Specialisations of the 'Id's function which exist
-#ifdef OLD_STRICTNESS
- cprInfo :: CprInfo, -- ^ If the 'Id's function always constructs a product result
- 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
-
+ -- 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
- newStrictnessInfo :: Maybe StrictSig, -- ^ Id strictness information. Reason for Maybe:
+ 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.
- newDemandInfo :: Maybe Demand -- ^ Id demand information. Similarly we want to know
+ 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
}
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 -> 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
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 }
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}
= IdInfo {
cafInfo = vanillaCafInfo,
arityInfo = unknownArity,
-#ifdef OLD_STRICTNESS
- cprInfo = NoCPRInfo,
- demandInfo = wwLazy,
- strictnessInfo = NoStrictnessInfo,
-#endif
specInfo = emptySpecInfo,
- workerInfo = NoWorker,
unfoldingInfo = noUnfolding,
lbvarInfo = NoLBVarInfo,
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
%************************************************************************
%* *
+ Strictness
+%* *
+%************************************************************************
+
+\begin{code}
+pprStrictness :: Maybe StrictSig -> SDoc
+pprStrictness Nothing = empty
+pprStrictness (Just sig) = ppr sig
+\end{code}
+
+
+%************************************************************************
+%* *
SpecInfo
%* *
%************************************************************************
+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
%************************************************************************
%* *
-\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}
%* *
%************************************************************************
seqCaf :: CafInfo -> ()
seqCaf c = c `seq` ()
+instance Outputable CafInfo where
+ ppr = ppCafInfo
+
ppCafInfo :: CafInfo -> SDoc
ppCafInfo NoCafRefs = ptext (sLit "NoCafRefs")
ppCafInfo MayHaveCafRefs = empty
%************************************************************************
%* *
-\subsection[cpr-IdInfo]{Constructed Product Result info about an @Id@}
-%* *
-%************************************************************************
-
-\begin{code}
-#ifdef OLD_STRICTNESS
--- | If the @Id@ is a function then it may have Constructed Product Result
--- (CPR) info. A CPR analysis phase detects whether:
---
--- 1. 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.
---
--- 2. 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.
---
--- 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.
-data CprInfo
- = NoCPRInfo -- ^ No, this function does not return a constructed product
- | 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
-
--- | It's always safe to assume that an 'Id' does not have the CPR property
-noCprInfo :: CprInt
-noCprInfo = NoCPRInfo
-
-seqCpr :: CprInfo -> ()
-seqCpr ReturnsCPR = ()
-seqCpr 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
-\end{code}
-
-%************************************************************************
-%* *
\subsection[lbvar-IdInfo]{Lambda-bound var info about an @Id@}
%* *
%************************************************************************
--
-- > (\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
\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}
-- ^ 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)
+ `setOccInfo` zapFragileOcc occ)
where
occ = occInfo info
\end{code}
projects / ghc-hetmet.git / blobdiff