X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FIdInfo.lhs;h=1c01ba4355612dded016d6665f011bead6a8da01;hp=1ebfcf9a78574f36b9444abf3874a6832017bb4d;hb=a3bab0506498db41853543558c52a4fda0d183af;hpb=2e06595241350a6548b6ab6430c65d6458f7c197 diff --git a/compiler/basicTypes/IdInfo.lhs b/compiler/basicTypes/IdInfo.lhs index 1ebfcf9..1c01ba4 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 @@ -26,33 +26,8 @@ module IdInfo ( 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, @@ -63,7 +38,7 @@ module IdInfo ( -- ** The OccInfo type OccInfo(..), - isFragileOcc, isDeadOcc, isLoopBreaker, + isDeadOcc, isLoopBreaker, occInfo, setOccInfo, InsideLam, OneBranch, @@ -89,176 +64,54 @@ module IdInfo ( 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 -\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 + `setStrictnessInfo`, + `setDemandInfo` \end{code} - %************************************************************************ %* * -\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,29 +121,45 @@ data GlobalIdDetails -- 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) - | 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 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 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} @@ -316,32 +185,19 @@ data IdInfo = 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 :: 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: + 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 } @@ -355,40 +211,36 @@ 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 -- 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 -> 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 } -#ifdef OLD_STRICTNESS -setStrictnessInfo info st = st `seq` info { strictnessInfo = st } -#endif -- Try to avoid spack leaks by seq'ing setUnfoldingInfoLazily :: IdInfo -> Unfolding -> IdInfo @@ -398,14 +250,11 @@ setUnfoldingInfoLazily info uf -- Lazy variant to avoid looking at the 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 } @@ -415,10 +264,11 @@ setCafInfo info caf = info { cafInfo = caf } 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} @@ -429,19 +279,13 @@ 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 @@ -497,7 +341,20 @@ 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} + + +%************************************************************************ +%* * + Strictness +%* * +%************************************************************************ + +\begin{code} +pprStrictness :: Maybe StrictSig -> SDoc +pprStrictness Nothing = empty +pprStrictness (Just sig) = ppr sig \end{code} @@ -507,6 +364,25 @@ type InlinePragInfo = Activation %* * %************************************************************************ +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 @@ -544,67 +420,6 @@ 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} %* * %************************************************************************ @@ -623,6 +438,7 @@ data CafInfo | NoCafRefs -- ^ A function or static constructor -- that refers to no CAFs. + deriving (Eq, Ord) -- | Assumes that the 'Id' has CAF references: definitely safe vanillaCafInfo :: CafInfo @@ -635,6 +451,9 @@ mayHaveCafRefs _ = False seqCaf :: CafInfo -> () seqCaf c = c `seq` () +instance Outputable CafInfo where + ppr = ppCafInfo + ppCafInfo :: CafInfo -> SDoc ppCafInfo NoCafRefs = ptext (sLit "NoCafRefs") ppCafInfo MayHaveCafRefs = empty @@ -642,59 +461,6 @@ 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@} %* * %************************************************************************ @@ -746,11 +512,11 @@ instance Show LBVarInfo where -- -- > (\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 @@ -768,8 +534,8 @@ zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand}) \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} @@ -778,9 +544,8 @@ 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) + `setOccInfo` zapFragileOcc occ) where occ = occInfo info \end{code}