X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FIdInfo.lhs;h=0db72f1bd6c4cc5a4290d214b382a31badd0f94f;hb=6065c9df3e0621193ccc944e11dc263db8e13354;hp=48597a5aebee7204dc9684de6d1a005faab76479;hpb=06babe955146e81fd458941aa765bbc4e260a310;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs index 48597a5..0db72f1 100644 --- a/ghc/compiler/basicTypes/IdInfo.lhs +++ b/ghc/compiler/basicTypes/IdInfo.lhs @@ -12,9 +12,12 @@ module IdInfo ( vanillaIdInfo, mkIdInfo, seqIdInfo, megaSeqIdInfo, + -- Zapping + zapFragileInfo, zapLamInfo, zapSpecPragInfo, shortableIdInfo, copyIdInfo, + -- Flavour IdFlavour(..), flavourInfo, - setNoDiscardInfo, zapSpecPragInfo, copyIdInfo, + setNoDiscardInfo, ppFlavourInfo, -- Arity @@ -22,15 +25,15 @@ module IdInfo ( exactArity, atLeastArity, unknownArity, hasArity, arityInfo, setArityInfo, ppArityInfo, arityLowerBound, - -- Strictness - StrictnessInfo(..), -- Non-abstract - mkStrictnessInfo, - noStrictnessInfo, strictnessInfo, - ppStrictnessInfo, setStrictnessInfo, - isBottomingStrictness, appIsBottom, + -- Strictness; imported from Demand + StrictnessInfo(..), + mkStrictnessInfo, noStrictnessInfo, + ppStrictnessInfo,isBottomingStrictness, + + strictnessInfo, setStrictnessInfo, -- Worker - WorkerInfo, workerExists, + WorkerInfo(..), workerExists, wrapperArity, workerId, workerInfo, setWorkerInfo, ppWorkerInfo, -- Unfolding @@ -40,25 +43,24 @@ module IdInfo ( demandInfo, setDemandInfo, -- Inline prags - InlinePragInfo(..), OccInfo(..), - inlinePragInfo, setInlinePragInfo, notInsideLambda, + InlinePragInfo(..), + inlinePragInfo, setInlinePragInfo, pprInlinePragInfo, + isNeverInlinePrag, neverInlinePrag, + + -- Occurrence info + OccInfo(..), isFragileOcc, isDeadOcc, isLoopBreaker, + InsideLam, OneBranch, insideLam, notInsideLam, oneBranch, notOneBranch, + occInfo, setOccInfo, -- Specialisation specInfo, setSpecInfo, - -- Update - UpdateInfo, UpdateSpec, - mkUpdateInfo, updateInfo, updateInfoMaybe, ppUpdateInfo, setUpdateInfo, - -- CAF info CafInfo(..), cafInfo, setCafInfo, ppCafInfo, -- Constructed Product Result Info CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo, - -- Zapping - zapLamIdInfo, zapFragileIdInfo, zapIdInfoForStg, - -- Lambda-bound variable info LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo ) where @@ -66,19 +68,21 @@ module IdInfo ( #include "HsVersions.h" -import {-# SOURCE #-} CoreUnfold ( Unfolding, noUnfolding, hasUnfolding, seqUnfolding ) -import {-# SOURCE #-} CoreSyn ( CoreExpr, CoreRules, emptyCoreRules, isEmptyCoreRules, seqRules ) -import {-# SOURCE #-} Const ( Con ) - +import CoreSyn +import PrimOp ( PrimOp ) import Var ( Id ) +import BasicTypes ( OccInfo(..), isFragileOcc, isDeadOcc, seqOccInfo, isLoopBreaker, + InsideLam, insideLam, notInsideLam, + OneBranch, oneBranch, notOneBranch, + Arity + ) +import DataCon ( DataCon ) import FieldLabel ( FieldLabel ) -import Demand ( Demand, isStrict, isLazy, wwLazy, pprDemands, seqDemand, seqDemands ) -import Type ( UsageAnn ) +import Demand -- Lots of stuff import Outputable import Maybe ( isJust ) -infixl 1 `setUpdateInfo`, - `setDemandInfo`, +infixl 1 `setDemandInfo`, `setStrictnessInfo`, `setSpecInfo`, `setArityInfo`, @@ -86,7 +90,8 @@ infixl 1 `setUpdateInfo`, `setUnfoldingInfo`, `setCprInfo`, `setWorkerInfo`, - `setCafInfo` + `setCafInfo`, + `setOccInfo` -- infixl so you can say (id `set` a `set` b) \end{code} @@ -117,11 +122,11 @@ data IdInfo strictnessInfo :: StrictnessInfo, -- Strictness properties workerInfo :: WorkerInfo, -- Pointer to Worker Function unfoldingInfo :: Unfolding, -- Its unfolding - updateInfo :: UpdateInfo, -- Which args should be updated cafInfo :: CafInfo, cprInfo :: CprInfo, -- Function always constructs a product result lbvarInfo :: LBVarInfo, -- Info about a lambda-bound variable - inlinePragInfo :: InlinePragInfo -- Inline pragmas + inlinePragInfo :: InlinePragInfo, -- Inline pragma + occInfo :: OccInfo -- How it occurs } seqIdInfo :: IdInfo -> () @@ -129,12 +134,12 @@ seqIdInfo (IdInfo {}) = () megaSeqIdInfo :: IdInfo -> () megaSeqIdInfo info - = seqFlavour (flavourInfo info) `seq` - seqArity (arityInfo info) `seq` - seqDemand (demandInfo info) `seq` - seqRules (specInfo info) `seq` - seqStrictness (strictnessInfo info) `seq` - seqWorker (workerInfo info) `seq` + = seqFlavour (flavourInfo info) `seq` + seqArity (arityInfo info) `seq` + seqDemand (demandInfo info) `seq` + seqRules (specInfo info) `seq` + seqStrictnessInfo (strictnessInfo info) `seq` + seqWorker (workerInfo info) `seq` -- seqUnfolding (unfoldingInfo info) `seq` -- Omitting this improves runtimes a little, presumably because @@ -143,7 +148,7 @@ megaSeqIdInfo info seqCaf (cafInfo info) `seq` seqCpr (cprInfo info) `seq` seqLBVar (lbvarInfo info) `seq` - seqInlinePrag (inlinePragInfo info) + seqOccInfo (occInfo info) \end{code} Setters @@ -152,14 +157,28 @@ Setters setWorkerInfo info wk = wk `seq` info { workerInfo = wk } setSpecInfo info sp = PSEQ sp (info { specInfo = sp }) setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr } +setOccInfo info oc = oc `seq` info { occInfo = oc } setStrictnessInfo info st = st `seq` info { strictnessInfo = st } -- Try to avoid spack leaks by seq'ing -setUnfoldingInfo info uf = info { unfoldingInfo = uf } +setUnfoldingInfo info uf + | isEvaldUnfolding uf && isStrict (demandInfo info) + -- If the unfolding is a value, the demand info may + -- go pear-shaped, so we nuke it. Example: + -- let x = (a,b) in + -- case x of (p,q) -> h p q x + -- Here x is certainly demanded. But after we've nuked + -- the case, we'll get just + -- let x = (a,b) in h a b x + -- and now x is not demanded (I'm assuming h is lazy) + -- This really happens. The solution here is a bit ad hoc... + = info { unfoldingInfo = uf, demandInfo = wwLazy } + + | otherwise -- We do *not* seq on the unfolding info, For some reason, doing so -- actually increases residency significantly. + = info { unfoldingInfo = uf } -setUpdateInfo info ud = info { updateInfo = ud } setDemandInfo info dd = info { demandInfo = dd } setArityInfo info ar = info { arityInfo = ar } setCafInfo info cf = info { cafInfo = cf } @@ -172,44 +191,6 @@ setNoDiscardInfo info = case flavourInfo info of zapSpecPragInfo info = case flavourInfo info of SpecPragmaId -> info { flavourInfo = VanillaId } other -> info - -copyIdInfo :: IdInfo -- From - -> IdInfo -- To - -> IdInfo -- To updated with stuff from From; except flavour unchanged --- copyIdInfo is used when shorting out a top-level binding --- f_local = BIG --- f = f_local --- where f is exported. We are going to swizzle it around to --- f = BIG --- f_local = f --- but we must be careful to combine their IdInfos right. --- The fact that things can go wrong here is a bad sign, but I can't see --- how to make it 'patently right', so copyIdInfo is derived (pretty much) by trial and error --- --- Here 'from' is f_local, 'to' is f. - -copyIdInfo from to = from { flavourInfo = flavourInfo to, - specInfo = specInfo to - } - -- It's important to propagate the inline pragmas from bndr - -- to exportd_id. Ditto strictness etc. This "bites" when we use an INLNE pragma: - -- {-# INLINE f #-} - -- f x = (x,x) - -- - -- This becomes (where the "*" means INLINE prag) - -- - -- M.f = /\a -> let mf* = \x -> (x,x) in mf - -- - -- Now the mf floats out and we end up with the trivial binding - -- - -- mf* = /\a -> \x -> (x,x) - -- M.f = mf - -- - -- Now, when we short out the M.f = mf binding we must preserve the inline - -- pragma on the mf binding. - -- - -- On the other hand, transformation rules may be attached to the - -- 'to' Id, and we want to preserve them. \end{code} @@ -223,14 +204,14 @@ mkIdInfo flv = IdInfo { arityInfo = UnknownArity, demandInfo = wwLazy, specInfo = emptyCoreRules, - workerInfo = Nothing, + workerInfo = NoWorker, strictnessInfo = NoStrictnessInfo, unfoldingInfo = noUnfolding, - updateInfo = NoUpdateInfo, cafInfo = MayHaveCafRefs, cprInfo = NoCPRInfo, lbvarInfo = NoLBVarInfo, - inlinePragInfo = NoInlinePragInfo + inlinePragInfo = NoInlinePragInfo, + occInfo = NoOccInfo } \end{code} @@ -243,18 +224,26 @@ mkIdInfo flv = IdInfo { \begin{code} data IdFlavour - = VanillaId -- Most Ids are like this - | ConstantId Con -- The Id for a constant (data constructor or primop) - | RecordSelId FieldLabel -- The Id for a record selector - | SpecPragmaId -- Don't discard these - | NoDiscardId -- Don't discard these either + = VanillaId -- Most Ids are like this + | DataConId 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] + | PrimOpId PrimOp -- The Id for a primitive operator + | RecordSelId FieldLabel -- The Id for a record selector + | SpecPragmaId -- Don't discard these + | NoDiscardId -- Don't discard these either ppFlavourInfo :: IdFlavour -> SDoc -ppFlavourInfo VanillaId = empty -ppFlavourInfo (ConstantId _) = ptext SLIT("[Constr]") -ppFlavourInfo (RecordSelId _) = ptext SLIT("[RecSel]") -ppFlavourInfo SpecPragmaId = ptext SLIT("[SpecPrag]") -ppFlavourInfo NoDiscardId = ptext SLIT("[NoDiscard]") +ppFlavourInfo VanillaId = empty +ppFlavourInfo (DataConId _) = ptext SLIT("[DataCon]") +ppFlavourInfo (DataConWrapId _) = ptext SLIT("[DataConWrapper]") +ppFlavourInfo (PrimOpId _) = ptext SLIT("[PrimOp]") +ppFlavourInfo (RecordSelId _) = ptext SLIT("[RecSel]") +ppFlavourInfo SpecPragmaId = ptext SLIT("[SpecPrag]") +ppFlavourInfo NoDiscardId = ptext SLIT("[NoDiscard]") seqFlavour :: IdFlavour -> () seqFlavour f = f `seq` () @@ -284,8 +273,20 @@ besides the code-generator need arity info!) \begin{code} data ArityInfo = UnknownArity -- No idea - | ArityExactly Int -- Arity is exactly this - | ArityAtLeast Int -- Arity is this or greater + + | ArityExactly Arity -- Arity is exactly this. We use this when importing a + -- function; it's already been compiled and we know its + -- arity for sure. + + | ArityAtLeast 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. + + -- functions in the module being compiled. Their arity + -- might increase later in the compilation process, if + -- an extra lambda floats up to the binding site. + deriving( Eq ) seqArity :: ArityInfo -> () seqArity a = arityLowerBound a `seq` () @@ -294,7 +295,7 @@ exactArity = ArityExactly atLeastArity = ArityAtLeast unknownArity = UnknownArity -arityLowerBound :: ArityInfo -> Int +arityLowerBound :: ArityInfo -> Arity arityLowerBound UnknownArity = 0 arityLowerBound (ArityAtLeast n) = n arityLowerBound (ArityExactly n) = n @@ -317,121 +318,36 @@ ppArityInfo (ArityAtLeast arity) = hsep [ptext SLIT("__AL"), int arity] \begin{code} data InlinePragInfo = NoInlinePragInfo + | IMustNotBeINLINEd Bool -- True <=> came from an INLINE prag, False <=> came from a NOINLINE prag + (Maybe Int) -- Phase number from pragma, if any + deriving( Eq ) + -- The True, Nothing case doesn't need to be recorded - | IMustNotBeINLINEd -- User NOINLINE pragma - - | IAmALoopBreaker -- Used by the occurrence analyser to mark loop-breakers - -- in a group of recursive definitions - - | ICanSafelyBeINLINEd -- Used by the occurrence analyser to mark things - -- that manifesly occur once, not inside SCCs, - -- not in constructor arguments + -- SEE COMMENTS WITH CoreUnfold.blackListed on the + -- exact significance of the IMustNotBeINLINEd pragma - OccInfo -- Says whether the occurrence is inside a lambda - -- If so, must only substitute WHNFs +isNeverInlinePrag :: InlinePragInfo -> Bool +isNeverInlinePrag (IMustNotBeINLINEd _ Nothing) = True +isNeverInlinePrag other = False - Bool -- False <=> occurs in more than one case branch - -- If so, there's a code-duplication issue - - | IAmDead -- Marks unused variables. Sometimes useful for - -- lambda and case-bound variables. - - | IMustBeINLINEd -- Absolutely must inline; used for PrimOps and - -- constructors only. - -seqInlinePrag :: InlinePragInfo -> () -seqInlinePrag (ICanSafelyBeINLINEd occ alts) - = occ `seq` alts `seq` () -seqInlinePrag other - = () +neverInlinePrag :: InlinePragInfo +neverInlinePrag = IMustNotBeINLINEd True{-should be False? --SDM -} Nothing instance Outputable InlinePragInfo where - -- only used for debugging; never parsed. KSW 1999-07 - ppr NoInlinePragInfo = empty - ppr IMustBeINLINEd = ptext SLIT("__UU") - ppr IMustNotBeINLINEd = ptext SLIT("__Unot") - ppr IAmALoopBreaker = ptext SLIT("__Ux") - ppr IAmDead = ptext SLIT("__Ud") - ppr (ICanSafelyBeINLINEd InsideLam _) = ptext SLIT("__Ul") - ppr (ICanSafelyBeINLINEd _ _) = ptext SLIT("__Us") - + -- This is now parsed in interface files + ppr NoInlinePragInfo = empty + ppr other_prag = ptext SLIT("__U") <> pprInlinePragInfo other_prag + +pprInlinePragInfo NoInlinePragInfo = empty +pprInlinePragInfo (IMustNotBeINLINEd True Nothing) = empty +pprInlinePragInfo (IMustNotBeINLINEd True (Just n)) = brackets (int n) +pprInlinePragInfo (IMustNotBeINLINEd False Nothing) = brackets (char '!') +pprInlinePragInfo (IMustNotBeINLINEd False (Just n)) = brackets (char '!' <> int n) + instance Show InlinePragInfo where showsPrec p prag = showsPrecSDoc p (ppr prag) \end{code} -\begin{code} -data OccInfo - = NotInsideLam - - | InsideLam -- Inside a non-linear lambda (that is, a lambda which - -- is sure to be instantiated only once). - -- Substituting a redex for this occurrence is - -- dangerous because it might duplicate work. - -instance Outputable OccInfo where - ppr NotInsideLam = empty - ppr InsideLam = text "l" - - -notInsideLambda :: OccInfo -> Bool -notInsideLambda NotInsideLam = True -notInsideLambda InsideLam = False -\end{code} - -%************************************************************************ -%* * -\subsection[strictness-IdInfo]{Strictness info about an @Id@} -%* * -%************************************************************************ - -We specify the strictness of a function by giving information about -each of the ``wrapper's'' arguments (see the description about -worker/wrapper-style transformations in the PJ/Launchbury paper on -unboxed types). - -The list of @Demands@ specifies: (a)~the strictness properties of a -function's arguments; and (b)~the type signature of that worker (if it -exists); i.e. its calling convention. - -Note that the existence of a worker function is now denoted by the Id's -workerInfo field. - -\begin{code} -data StrictnessInfo - = NoStrictnessInfo - - | StrictnessInfo [Demand] - Bool -- True <=> the function diverges regardless of its arguments - -- Useful for "error" and other disguised variants thereof. - -- BUT NB: f = \x y. error "urk" - -- will have info SI [SS] True - -- but still (f) and (f 2) are not bot; only (f 3 2) is bot - -seqStrictness :: StrictnessInfo -> () -seqStrictness (StrictnessInfo ds b) = b `seq` seqDemands ds -seqStrictness other = () -\end{code} - -\begin{code} -mkStrictnessInfo :: ([Demand], Bool) -> StrictnessInfo - -mkStrictnessInfo (xs, is_bot) - | all isLazy xs && not is_bot = NoStrictnessInfo -- Uninteresting - | otherwise = StrictnessInfo xs is_bot - -noStrictnessInfo = NoStrictnessInfo - -isBottomingStrictness (StrictnessInfo _ bot) = bot -isBottomingStrictness NoStrictnessInfo = False - --- appIsBottom returns true if an application to n args would diverge -appIsBottom (StrictnessInfo ds bot) n = bot && (n >= length ds) -appIsBottom NoStrictnessInfo n = False - -ppStrictnessInfo NoStrictnessInfo = empty -ppStrictnessInfo (StrictnessInfo wrapper_args bot) - = hsep [ptext SLIT("__S"), pprDemands wrapper_args bot] -\end{code} %************************************************************************ %* * @@ -450,60 +366,31 @@ There might not be a worker, even for a strict function, because: \begin{code} -type WorkerInfo = Maybe Id - -{- UNUSED: -mkWorkerInfo :: Id -> WorkerInfo -mkWorkerInfo wk_id = Just wk_id --} +data WorkerInfo = NoWorker + | HasWorker Id Arity + -- The Arity is the arity of the *wrapper* at the moment of the + -- w/w split. See comments in MkIface.ifaceId, with the 'Worker' code. seqWorker :: WorkerInfo -> () -seqWorker (Just id) = id `seq` () -seqWorker Nothing = () +seqWorker (HasWorker id _) = id `seq` () +seqWorker NoWorker = () -ppWorkerInfo Nothing = empty -ppWorkerInfo (Just wk_id) = ptext SLIT("__P") <+> ppr wk_id - -noWorkerInfo = Nothing - -workerExists :: Maybe Id -> Bool -workerExists = isJust -\end{code} +ppWorkerInfo NoWorker = empty +ppWorkerInfo (HasWorker wk_id _) = ptext SLIT("__P") <+> ppr wk_id +noWorkerInfo = NoWorker -%************************************************************************ -%* * -\subsection[update-IdInfo]{Update-analysis info about an @Id@} -%* * -%************************************************************************ - -\begin{code} -data UpdateInfo - = NoUpdateInfo - | SomeUpdateInfo UpdateSpec - deriving (Eq, Ord) - -- we need Eq/Ord to cross-chk update infos in interfaces - --- the form in which we pass update-analysis info between modules: -type UpdateSpec = [Int] -\end{code} +workerExists :: WorkerInfo -> Bool +workerExists NoWorker = False +workerExists (HasWorker _ _) = True -\begin{code} -mkUpdateInfo = SomeUpdateInfo +workerId :: WorkerInfo -> Id +workerId (HasWorker id _) = id -updateInfoMaybe NoUpdateInfo = Nothing -updateInfoMaybe (SomeUpdateInfo []) = Nothing -updateInfoMaybe (SomeUpdateInfo u) = Just u +wrapperArity :: WorkerInfo -> Arity +wrapperArity (HasWorker _ a) = a \end{code} -Text instance so that the update annotations can be read in. - -\begin{code} -ppUpdateInfo NoUpdateInfo = empty -ppUpdateInfo (SomeUpdateInfo []) = empty -ppUpdateInfo (SomeUpdateInfo spec) = (<>) (ptext SLIT("__UA ")) (hcat (map int spec)) - -- was "__U "; changed to avoid conflict with unfoldings. KSW 1999-07. -\end{code} %************************************************************************ %* * @@ -537,98 +424,6 @@ ppCafInfo MayHaveCafRefs = empty %************************************************************************ %* * -\subsection[CAF-IdInfo]{CAF-related information} -%* * -%************************************************************************ - -zapFragileIdInfo is used when cloning binders, mainly in the -simplifier. We must forget about used-once information because that -isn't necessarily correct in the transformed program. -Also forget specialisations and unfoldings because they would need -substitution to be correct. (They get pinned back on separately.) - -\begin{code} -zapFragileIdInfo :: IdInfo -> Maybe IdInfo -zapFragileIdInfo info@(IdInfo {inlinePragInfo = inline_prag, - workerInfo = wrkr, - specInfo = rules, - unfoldingInfo = unfolding}) - | not is_fragile_inline_prag - -- We must forget about whether it was marked safe-to-inline, - -- because that isn't necessarily true in the simplified expression. - -- This is important because expressions may be re-simplified - - && isEmptyCoreRules rules - -- Specialisations would need substituting. They get pinned - -- back on separately. - - && not (workerExists wrkr) - - && not (hasUnfolding unfolding) - -- This is very important; occasionally a let-bound binder is used - -- as a binder in some lambda, in which case its unfolding is utterly - -- bogus. Also the unfolding uses old binders so if we left it we'd - -- have to substitute it. Much better simply to give the Id a new - -- unfolding each time, which is what the simplifier does. - = Nothing - - | otherwise - = Just (info {inlinePragInfo = safe_inline_prag, - workerInfo = noWorkerInfo, - specInfo = emptyCoreRules, - unfoldingInfo = noUnfolding}) - - where - is_fragile_inline_prag = case inline_prag of - ICanSafelyBeINLINEd _ _ -> True - --- We used to say the dead-ness was fragile, but I don't --- see why it is. Furthermore, deadness is a pain to lose; --- see Simplify.mkDupableCont (Select ...) --- IAmDead -> True - - other -> False - - -- Be careful not to destroy real 'pragma' info - safe_inline_prag | is_fragile_inline_prag = NoInlinePragInfo - | otherwise = inline_prag -\end{code} - - -@zapLamIdInfo@ is used for lambda binders that turn out to to be -part of an unsaturated lambda - -\begin{code} -zapLamIdInfo :: IdInfo -> Maybe IdInfo -zapLamIdInfo info@(IdInfo {inlinePragInfo = inline_prag, demandInfo = demand}) - | is_safe_inline_prag && not (isStrict demand) - = Nothing - | otherwise - = Just (info {inlinePragInfo = safe_inline_prag, - demandInfo = wwLazy}) - where - -- The "unsafe" prags are the ones that say I'm not in a lambda - -- because that might not be true for an unsaturated lambda - is_safe_inline_prag = case inline_prag of - ICanSafelyBeINLINEd NotInsideLam nalts -> False - other -> True - - safe_inline_prag = case inline_prag of - ICanSafelyBeINLINEd _ nalts - -> ICanSafelyBeINLINEd InsideLam nalts - other -> inline_prag -\end{code} - -\begin{code} -zapIdInfoForStg :: IdInfo -> IdInfo - -- Return only the info needed for STG stuff - -- Namely, nothing, I think -zapIdInfoForStg info = vanillaIdInfo -\end{code} - - -%************************************************************************ -%* * \subsection[cpr-IdInfo]{Constructed Product Result info about an @Id@} %* * %************************************************************************ @@ -654,41 +449,25 @@ also CPRs. \begin{code} data CprInfo = NoCPRInfo - - | CPRInfo [CprInfo] - --- e.g. const 5 == CPRInfo [NoCPRInfo] --- == __M(-) --- \x -> (5, --- (x, --- 5, --- x) --- ) --- CPRInfo [CPRInfo [NoCPRInfo], --- CPRInfo [NoCprInfo, --- CPRInfo [NoCPRInfo], --- NoCPRInfo] --- ] --- __M((-)(-(-)-)-) + | 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 \end{code} \begin{code} seqCpr :: CprInfo -> () -seqCpr (CPRInfo cs) = seqCprs cs -seqCpr NoCPRInfo = () - -seqCprs [] = () -seqCprs (c:cs) = seqCpr c `seq` seqCprs cs - +seqCpr ReturnsCPR = () +seqCpr NoCPRInfo = () noCprInfo = NoCPRInfo -ppCprInfo NoCPRInfo = empty -ppCprInfo c@(CPRInfo _) - = hsep [ptext SLIT("__M"), ppCprInfo' c] - where - ppCprInfo' NoCPRInfo = char '-' - ppCprInfo' (CPRInfo args) = parens (hcat (map ppCprInfo' args)) +ppCprInfo NoCPRInfo = empty +ppCprInfo ReturnsCPR = ptext SLIT("__M") instance Outputable CprInfo where ppr = ppCprInfo @@ -742,3 +521,146 @@ instance Outputable LBVarInfo where instance Show LBVarInfo where showsPrec p c = showsPrecSDoc p (ppr c) \end{code} + + +%************************************************************************ +%* * +\subsection{Bulk operations on IdInfo} +%* * +%************************************************************************ + +zapFragileInfo is used when cloning binders, mainly in the +simplifier. We must forget about used-once information because that +isn't necessarily correct in the transformed program. +Also forget specialisations and unfoldings because they would need +substitution to be correct. (They get pinned back on separately.) + +\begin{code} +zapFragileInfo :: IdInfo -> Maybe IdInfo +zapFragileInfo info@(IdInfo {occInfo = occ, + workerInfo = wrkr, + specInfo = rules, + unfoldingInfo = unfolding}) + | not (isFragileOcc occ) + -- We must forget about whether it was marked safe-to-inline, + -- because that isn't necessarily true in the simplified expression. + -- This is important because expressions may be re-simplified + -- We don't zap deadness or loop-breaker-ness. + -- The latter is important because it tells MkIface not to + -- spit out an inlining for the thing. The former doesn't + -- seem so important, but there's no harm. + + && isEmptyCoreRules rules + -- Specialisations would need substituting. They get pinned + -- back on separately. + + && not (workerExists wrkr) + + && not (hasUnfolding unfolding) + -- This is very important; occasionally a let-bound binder is used + -- as a binder in some lambda, in which case its unfolding is utterly + -- bogus. Also the unfolding uses old binders so if we left it we'd + -- have to substitute it. Much better simply to give the Id a new + -- unfolding each time, which is what the simplifier does. + = Nothing + + | otherwise + = Just (info {occInfo = robust_occ_info, + workerInfo = noWorkerInfo, + specInfo = emptyCoreRules, + unfoldingInfo = noUnfolding}) + where + -- It's important to keep the loop-breaker info, + -- because the substitution doesn't remember it. + robust_occ_info = case occ of + OneOcc _ _ -> NoOccInfo + other -> occ +\end{code} + +@zapLamInfo@ is used for lambda binders that turn out to to be +part of an unsaturated lambda + +\begin{code} +zapLamInfo :: IdInfo -> Maybe IdInfo +zapLamInfo info@(IdInfo {occInfo = occ, demandInfo = demand}) + | is_safe_occ && not (isStrict demand) + = Nothing + | otherwise + = Just (info {occInfo = safe_occ, + demandInfo = wwLazy}) + 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 = case occ of + OneOcc in_lam once -> in_lam + other -> True + + safe_occ = case occ of + OneOcc _ once -> OneOcc insideLam once + other -> occ +\end{code} + + +copyIdInfo is used when shorting out a top-level binding + f_local = BIG + f = f_local +where f is exported. We are going to swizzle it around to + f = BIG + f_local = f + +BUT (a) we must be careful about messing up rules + (b) we must ensure f's IdInfo ends up right + +(a) Messing up the rules +~~~~~~~~~~~~~~~~~~~~ +The example that went bad on me was this one: + + iterate :: (a -> a) -> a -> [a] + iterate = iterateList + + iterateFB c f x = x `c` iterateFB c f (f x) + iterateList f x = x : iterateList f (f x) + + {-# RULES + "iterate" forall f x. iterate f x = build (\c _n -> iterateFB c f x) + "iterateFB" iterateFB (:) = iterateList + #-} + +This got shorted out to: + + iterateList :: (a -> a) -> a -> [a] + iterateList = iterate + + iterateFB c f x = x `c` iterateFB c f (f x) + iterate f x = x : iterate f (f x) + + {-# RULES + "iterate" forall f x. iterate f x = build (\c _n -> iterateFB c f x) + "iterateFB" iterateFB (:) = iterate + #-} + +And now we get an infinite loop in the rule system + iterate f x -> build (\cn -> iterateFB c f x + -> iterateFB (:) f x + -> iterate f x + +Tiresome solution: don't do shorting out if f has rewrite rules. +Hence shortableIdInfo. + +(b) Keeping the IdInfo right +~~~~~~~~~~~~~~~~~~~~~~~~ +We want to move strictness/worker info from f_local to f, but keep the rest. +Hence copyIdInfo. + +\begin{code} +shortableIdInfo :: IdInfo -> Bool +shortableIdInfo info = isEmptyCoreRules (specInfo info) + +copyIdInfo :: IdInfo -- f_local + -> IdInfo -- f (the exported one) + -> IdInfo -- New info for f +copyIdInfo f_local f = f { strictnessInfo = strictnessInfo f_local, + workerInfo = workerInfo f_local, + cprInfo = cprInfo f_local + } +\end{code}