X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FIdInfo.lhs;h=1aecb5452f99a5e98627d100ca74b8d37095ab0c;hb=1181f398e73359a2e6387364b4fe270d4cc78f36;hp=2c36363b4e0de97ad9b4c1c10a903a3b3b87abd3;hpb=9d38678ea60ff32f756390a30c659daa22c98c93;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs index 2c36363..1aecb54 100644 --- a/ghc/compiler/basicTypes/IdInfo.lhs +++ b/ghc/compiler/basicTypes/IdInfo.lhs @@ -8,29 +8,38 @@ Haskell. [WDP 94/11]) \begin{code} module IdInfo ( - IdInfo, -- Abstract + GlobalIdDetails(..), notGlobalId, -- Not abstract - vanillaIdInfo, mkIdInfo, + IdInfo, -- Abstract + vanillaIdInfo, noCafNoTyGenIdInfo, + seqIdInfo, megaSeqIdInfo, - -- Flavour - IdFlavour(..), flavourInfo, - setNoDiscardInfo, zapSpecPragInfo, copyIdInfo, - ppFlavourInfo, + -- Zapping + zapLamInfo, zapDemandInfo, + shortableIdInfo, copyIdInfo, -- Arity - ArityInfo(..), - exactArity, atLeastArity, unknownArity, hasArity, - arityInfo, setArityInfo, ppArityInfo, arityLowerBound, + ArityInfo, + unknownArity, + arityInfo, setArityInfo, ppArityInfo, + + -- New demand and strictness info + newStrictnessInfo, setNewStrictnessInfo, mkNewStrictnessInfo, + newDemandInfo, setNewDemandInfo, newDemand, oldDemand, + + -- Strictness; imported from Demand + StrictnessInfo(..), + mkStrictnessInfo, noStrictnessInfo, + ppStrictnessInfo,isBottomingStrictness, + strictnessInfo, setStrictnessInfo, - -- Strictness - StrictnessInfo(..), -- Non-abstract - mkStrictnessInfo, - noStrictnessInfo, strictnessInfo, - ppStrictnessInfo, setStrictnessInfo, - isBottomingStrictness, appIsBottom, + -- Usage generalisation + TyGenInfo(..), + tyGenInfo, setTyGenInfo, + noTyGenInfo, isNoTyGenInfo, ppTyGenInfo, tyGenInfoString, -- Worker - WorkerInfo, workerExists, + WorkerInfo(..), workerExists, wrapperArity, workerId, workerInfo, setWorkerInfo, ppWorkerInfo, -- Unfolding @@ -40,45 +49,63 @@ module IdInfo ( demandInfo, setDemandInfo, -- Inline prags - InlinePragInfo(..), OccInfo(..), - inlinePragInfo, setInlinePragInfo, notInsideLambda, + InlinePragInfo, + inlinePragInfo, setInlinePragInfo, + + -- 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, + -- CG info + CgInfo(..), cgInfo, setCgInfo, pprCgInfo, + cgCafInfo, vanillaCgInfo, + CgInfoEnv, lookupCgInfo, -- CAF info - CafInfo(..), cafInfo, setCafInfo, ppCafInfo, + CafInfo(..), ppCafInfo, setCafInfo, mayHaveCafRefs, -- Constructed Product Result Info CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo, - -- Zapping - zapLamIdInfo, zapFragileIdInfo, - -- Lambda-bound variable info - LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo + LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo, hasNoLBVarInfo ) where #include "HsVersions.h" -import {-# SOURCE #-} CoreUnfold ( Unfolding, noUnfolding, hasUnfolding ) -import {-# SOURCE #-} CoreSyn ( CoreExpr, CoreRules, emptyCoreRules, isEmptyCoreRules ) -import {-# SOURCE #-} Const ( Con ) - +import CoreSyn +import Type ( Type, usOnce, eqUsage ) +import PrimOp ( PrimOp ) +import NameEnv ( NameEnv, lookupNameEnv ) +import Name ( Name ) import Var ( Id ) +import BasicTypes ( OccInfo(..), isFragileOcc, isDeadOcc, seqOccInfo, isLoopBreaker, + InsideLam, insideLam, notInsideLam, + OneBranch, oneBranch, notOneBranch, + Arity, + Activation(..) + ) +import DataCon ( DataCon ) +import ForeignCall ( ForeignCall ) import FieldLabel ( FieldLabel ) -import Demand ( Demand, isStrict, isLazy, wwLazy, pprDemands ) -import Type ( UsageAnn ) +import Type ( usOnce, usMany ) +import Demand hiding( Demand ) +import qualified Demand +import NewDemand ( Demand(..), Keepity(..), DmdResult(..), + lazyDmd, topDmd, dmdTypeDepth, isStrictDmd, + StrictSig, mkStrictSig, mkTopDmdType + ) import Outputable -import Maybe ( isJust ) +import Util ( seqList ) +import List ( replicate ) -infixl 1 `setUpdateInfo`, - `setDemandInfo`, +infixl 1 `setDemandInfo`, + `setTyGenInfo`, `setStrictnessInfo`, `setSpecInfo`, `setArityInfo`, @@ -86,18 +113,115 @@ infixl 1 `setUpdateInfo`, `setUnfoldingInfo`, `setCprInfo`, `setWorkerInfo`, - `setCafInfo` + `setLBVarInfo`, + `setOccInfo`, + `setCgInfo`, + `setCafInfo`, + `setNewStrictnessInfo`, + `setNewDemandInfo` -- infixl so you can say (id `set` a `set` b) \end{code} +%************************************************************************ +%* * +\subsection{New strictness info} +%* * +%************************************************************************ + +To be removed later + +\begin{code} +mkNewStrictnessInfo :: Id -> Arity -> Demand.StrictnessInfo -> CprInfo -> StrictSig +mkNewStrictnessInfo id arity (Demand.StrictnessInfo ds res) cpr + | length ds <= arity + -- Sometimes the old strictness analyser has more + -- demands than the arity justifies + = mk_strict_sig id arity $ + mkTopDmdType (map newDemand ds) (newRes res cpr) + +mkNewStrictnessInfo id arity other cpr + = -- Either no strictness info, or arity is too small + -- In either case we can't say anything useful + mk_strict_sig id arity $ + mkTopDmdType (replicate arity lazyDmd) (newRes False cpr) + +mk_strict_sig id arity dmd_ty + = WARN( arity /= dmdTypeDepth dmd_ty, ppr id <+> (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) = Lazy +newDemand WwStrict = Eval +newDemand (WwUnpack unpk ds) = Seq Drop (map newDemand ds) +newDemand WwPrim = Lazy +newDemand WwEnum = Eval + +oldDemand :: NewDemand.Demand -> Demand.Demand +oldDemand Abs = WwLazy True +oldDemand Lazy = WwLazy False +oldDemand Bot = WwStrict +oldDemand Err = WwStrict +oldDemand Eval = WwStrict +oldDemand (Seq _ ds) = WwUnpack True (map oldDemand ds) +oldDemand (Call _) = WwStrict +\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 FieldLabel -- The Id for a record selector + | 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 + | FCallId ForeignCall -- The Id for a foreign call + + | 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 (DataConId _) = ptext SLIT("[DataCon]") + ppr (DataConWrapId _) = ptext SLIT("[DataConWrapper]") + ppr (PrimOpId _) = ptext SLIT("[PrimOp]") + ppr (FCallId _) = ptext SLIT("[ForeignCall]") + ppr (RecordSelId _) = ptext SLIT("[RecSel]") +\end{code} + + +%************************************************************************ +%* * +\subsection{The main IdInfo type} +%* * +%************************************************************************ + 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. - There is one exception: the 'flavour' is *not* optional. - You must not discard it. - It used to be in Var.lhs, but that seems unclean. - 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. @@ -110,137 +234,117 @@ case. KSW 1999-04). \begin{code} data IdInfo = IdInfo { - flavourInfo :: IdFlavour, -- NOT OPTIONAL arityInfo :: ArityInfo, -- Its arity - demandInfo :: Demand, -- Whether or not it is definitely demanded + demandInfo :: Demand.Demand, -- Whether or not it is definitely demanded specInfo :: CoreRules, -- Specialisations of this function which exist + tyGenInfo :: TyGenInfo, -- Restrictions on usage-generalisation of this Id strictnessInfo :: StrictnessInfo, -- Strictness properties workerInfo :: WorkerInfo, -- Pointer to Worker Function unfoldingInfo :: Unfolding, -- Its unfolding - updateInfo :: UpdateInfo, -- Which args should be updated - cafInfo :: CafInfo, + cgInfo :: CgInfo, -- Code generator info (arity, CAF info) 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 + + 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 :: Demand } + +seqIdInfo :: IdInfo -> () +seqIdInfo (IdInfo {}) = () + +megaSeqIdInfo :: IdInfo -> () +megaSeqIdInfo info + = seqArity (arityInfo info) `seq` + seqDemand (demandInfo info) `seq` + seqRules (specInfo info) `seq` + seqTyGenInfo (tyGenInfo info) `seq` + seqStrictnessInfo (strictnessInfo info) `seq` + seqWorker (workerInfo info) `seq` + +-- seqUnfolding (unfoldingInfo info) `seq` +-- Omitting this improves runtimes a little, presumably because +-- some unfoldings are not calculated at all + +-- CgInfo is involved in a loop, so we have to be careful not to seq it +-- too early. +-- seqCg (cgInfo info) `seq` + seqCpr (cprInfo info) `seq` + seqLBVar (lbvarInfo info) `seq` + seqOccInfo (occInfo info) \end{code} Setters \begin{code} -setUpdateInfo info ud = info { updateInfo = ud } +setWorkerInfo info wk = wk `seq` info { workerInfo = wk } +setSpecInfo info sp = sp `seq` info { specInfo = sp } +setTyGenInfo info tg = tg `seq` info { tyGenInfo = tg } +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 + | isEvaldUnfolding uf + -- 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, newDemandInfo = Lazy } + + | otherwise + -- We do *not* seq on the unfolding info, For some reason, doing so + -- actually increases residency significantly. + = info { unfoldingInfo = uf } + setDemandInfo info dd = info { demandInfo = dd } -setStrictnessInfo info st = info { strictnessInfo = st } -setWorkerInfo info wk = info { workerInfo = wk } -setSpecInfo info sp = info { specInfo = sp } setArityInfo info ar = info { arityInfo = ar } -setInlinePragInfo info pr = info { inlinePragInfo = pr } -setUnfoldingInfo info uf = info { unfoldingInfo = uf } -setCafInfo info cf = info { cafInfo = cf } +setCgInfo info cg = info { cgInfo = cg } setCprInfo info cp = info { cprInfo = cp } setLBVarInfo info lb = info { lbvarInfo = lb } -setNoDiscardInfo info = case flavourInfo info of - VanillaId -> info { flavourInfo = NoDiscardId } - other -> info -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. +setNewDemandInfo info dd = info { newDemandInfo = dd } +setNewStrictnessInfo info dd = info { newStrictnessInfo = dd } \end{code} \begin{code} vanillaIdInfo :: IdInfo -vanillaIdInfo = mkIdInfo VanillaId - -mkIdInfo :: IdFlavour -> IdInfo -mkIdInfo flv = IdInfo { - flavourInfo = flv, - arityInfo = UnknownArity, - demandInfo = wwLazy, - specInfo = emptyCoreRules, - workerInfo = Nothing, - strictnessInfo = NoStrictnessInfo, - unfoldingInfo = noUnfolding, - updateInfo = NoUpdateInfo, - cafInfo = MayHaveCafRefs, - cprInfo = NoCPRInfo, - lbvarInfo = NoLBVarInfo, - inlinePragInfo = NoInlinePragInfo +vanillaIdInfo + = IdInfo { + cgInfo = noCgInfo, + arityInfo = unknownArity, + demandInfo = wwLazy, + specInfo = emptyCoreRules, + tyGenInfo = noTyGenInfo, + workerInfo = NoWorker, + strictnessInfo = NoStrictnessInfo, + unfoldingInfo = noUnfolding, + cprInfo = NoCPRInfo, + lbvarInfo = NoLBVarInfo, + inlinePragInfo = AlwaysActive, + occInfo = NoOccInfo, + newDemandInfo = topDmd, + newStrictnessInfo = Nothing } -\end{code} - -%************************************************************************ -%* * -\subsection{Flavour} -%* * -%************************************************************************ - -\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 - -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]") +noCafNoTyGenIdInfo = vanillaIdInfo `setTyGenInfo` TyGenNever + `setCgInfo` CgInfo NoCafRefs + -- Used for built-in type Ids in MkId. + -- Many built-in things have fixed types, so we shouldn't + -- run around generalising them \end{code} -The @SpecPragmaId@ exists only to make Ids that are -on the *LHS* of bindings created by SPECIALISE pragmas; -eg: s = f Int d -The SpecPragmaId is never itself mentioned; it -exists solely so that the specialiser will find -the call to f, and make specialised version of it. -The SpecPragmaId binding is discarded by the specialiser -when it gathers up overloaded calls. -Meanwhile, it is not discarded as dead code. - %************************************************************************ %* * @@ -253,27 +357,22 @@ of their arities; so it should not be asking... (but other things 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 - -exactArity = ArityExactly -atLeastArity = ArityAtLeast -unknownArity = UnknownArity - -arityLowerBound :: ArityInfo -> Int -arityLowerBound UnknownArity = 0 -arityLowerBound (ArityAtLeast n) = n -arityLowerBound (ArityExactly n) = n - -hasArity :: ArityInfo -> Bool -hasArity UnknownArity = False -hasArity other = True - -ppArityInfo UnknownArity = empty -ppArityInfo (ArityExactly arity) = hsep [ptext SLIT("__A"), int arity] -ppArityInfo (ArityAtLeast arity) = hsep [ptext SLIT("__AL"), int arity] +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. + +seqArity :: ArityInfo -> () +seqArity a = a `seq` () + +unknownArity = 0 :: Arity + +ppArityInfo 0 = empty +ppArityInfo n = hsep [ptext SLIT("Arity"), int n] \end{code} %************************************************************************ @@ -283,113 +382,91 @@ ppArityInfo (ArityAtLeast arity) = hsep [ptext SLIT("__AL"), int arity] %************************************************************************ \begin{code} -data InlinePragInfo - = NoInlinePragInfo - - | 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 - - OccInfo -- Says whether the occurrence is inside a lambda - -- If so, must only substitute WHNFs - - 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. - -instance Outputable InlinePragInfo where - 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") - -instance Show InlinePragInfo where - showsPrec p prag = showsPrecSDoc p (ppr prag) +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 \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@} -%* * +%* * +\subsection[TyGen-IdInfo]{Type generalisation 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). +Certain passes (notably usage inference) may change the type of an +identifier, modifying all in-scope uses of that identifier +appropriately to maintain type safety. -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. +However, some identifiers must not have their types changed in this +way, because their types are conjured up in the front end of the +compiler rather than being read from the interface file. Default +methods, dictionary functions, record selectors, and others are in +this category. (see comment at TcClassDcl.tcClassSig). -Note that the existence of a worker function is now denoted by the Id's -workerInfo field. +To indicate this property, such identifiers are marked TyGenNever. -\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 -\end{code} +Furthermore, if the usage inference generates a usage-specialised +variant of a function, we must NOT re-infer a fully-generalised type +at the next inference. This finer property is indicated by a +TyGenUInfo on the identifier. \begin{code} -mkStrictnessInfo :: ([Demand], Bool) -> StrictnessInfo - -mkStrictnessInfo (xs, is_bot) - | all isLazy xs && not is_bot = NoStrictnessInfo -- Uninteresting - | otherwise = StrictnessInfo xs is_bot +data TyGenInfo + = NoTyGenInfo -- no restriction on type generalisation -noStrictnessInfo = NoStrictnessInfo + | TyGenUInfo [Maybe Type] -- restrict generalisation of this Id to + -- preserve specified usage annotations -isBottomingStrictness (StrictnessInfo _ bot) = bot -isBottomingStrictness NoStrictnessInfo = False + | TyGenNever -- never generalise the type of this Id +\end{code} --- appIsBottom returns true if an application to n args would diverge -appIsBottom (StrictnessInfo ds bot) n = bot && (n >= length ds) -appIsBottom NoStrictnessInfo n = False +For TyGenUInfo, the list has one entry for each usage annotation on +the type of the Id, in left-to-right pre-order (annotations come +before the type they annotate). Nothing means no restriction; Just +usOnce or Just usMany forces that annotation to that value. Other +usage annotations are illegal. -ppStrictnessInfo NoStrictnessInfo = empty -ppStrictnessInfo (StrictnessInfo wrapper_args bot) - = hsep [ptext SLIT("__S"), pprDemands wrapper_args bot] +\begin{code} +seqTyGenInfo :: TyGenInfo -> () +seqTyGenInfo NoTyGenInfo = () +seqTyGenInfo (TyGenUInfo us) = seqList us () +seqTyGenInfo TyGenNever = () + +noTyGenInfo :: TyGenInfo +noTyGenInfo = NoTyGenInfo + +isNoTyGenInfo :: TyGenInfo -> Bool +isNoTyGenInfo NoTyGenInfo = True +isNoTyGenInfo _ = False + +-- NB: There's probably no need to write this information out to the interface file. +-- Why? Simply because imported identifiers never get their types re-inferred. +-- But it's definitely nice to see in dumps, it for debugging purposes. + +ppTyGenInfo :: TyGenInfo -> SDoc +ppTyGenInfo NoTyGenInfo = empty +ppTyGenInfo (TyGenUInfo us) = ptext SLIT("__G") <+> text (tyGenInfoString us) +ppTyGenInfo TyGenNever = ptext SLIT("__G N") + +tyGenInfoString us = map go us + where go Nothing = 'x' -- for legibility, choose + go (Just u) | u `eqUsage` usOnce = '1' -- chars with identity + | u `eqUsage` usMany = 'M' -- Z-encoding. + go other = pprPanic "IdInfo.tyGenInfoString: unexpected annotation" (ppr other) + +instance Outputable TyGenInfo where + ppr = ppTyGenInfo + +instance Show TyGenInfo where + showsPrec p c = showsPrecSDoc p (ppr c) \end{code} + %************************************************************************ %* * \subsection[worker-IdInfo]{Worker info about an @Id@} @@ -405,68 +482,82 @@ There might not be a worker, even for a strict function, because: 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} -type WorkerInfo = Maybe 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 (HasWorker id _) = id `seq` () +seqWorker NoWorker = () -{- UNUSED: -mkWorkerInfo :: Id -> WorkerInfo -mkWorkerInfo wk_id = Just wk_id --} +ppWorkerInfo NoWorker = empty +ppWorkerInfo (HasWorker wk_id _) = ptext SLIT("__P") <+> ppr wk_id -ppWorkerInfo Nothing = empty -ppWorkerInfo (Just wk_id) = ptext SLIT("__P") <+> ppr wk_id +workerExists :: WorkerInfo -> Bool +workerExists NoWorker = False +workerExists (HasWorker _ _) = True -noWorkerInfo = Nothing +workerId :: WorkerInfo -> Id +workerId (HasWorker id _) = id -workerExists :: Maybe Id -> Bool -workerExists = isJust +wrapperArity :: WorkerInfo -> Arity +wrapperArity (HasWorker _ a) = a \end{code} %************************************************************************ %* * -\subsection[update-IdInfo]{Update-analysis info about an @Id@} +\subsection[CG-IdInfo]{Code generator-related information} %* * %************************************************************************ -\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} +CgInfo encapsulates calling-convention information produced by the code +generator. It is pasted into the IdInfo of each emitted Id by CoreTidy, +but only as a thunk --- the information is only actually produced further +downstream, by the code generator. \begin{code} -mkUpdateInfo = SomeUpdateInfo +#ifndef DEBUG +newtype CgInfo = CgInfo CafInfo -- We are back to only having CafRefs in CgInfo +noCgInfo = panic "NoCgInfo!" +#else +data CgInfo = CgInfo CafInfo + | NoCgInfo -- In debug mode we don't want a black hole here + -- See Id.idCgInfo + -- noCgInfo is used for local Ids, which shouldn't need any CgInfo +noCgInfo = NoCgInfo +#endif -updateInfoMaybe NoUpdateInfo = Nothing -updateInfoMaybe (SomeUpdateInfo []) = Nothing -updateInfoMaybe (SomeUpdateInfo u) = Just u -\end{code} +cgCafInfo (CgInfo caf_info) = caf_info -Text instance so that the update annotations can be read in. +setCafInfo info caf_info = info `setCgInfo` CgInfo caf_info -\begin{code} -ppUpdateInfo NoUpdateInfo = empty -ppUpdateInfo (SomeUpdateInfo []) = empty -ppUpdateInfo (SomeUpdateInfo spec) = (<>) (ptext SLIT("__U ")) (hcat (map int spec)) -\end{code} +seqCg c = c `seq` () -- fields are strict anyhow -%************************************************************************ -%* * -\subsection[CAF-IdInfo]{CAF-related information} -%* * -%************************************************************************ +vanillaCgInfo = CgInfo MayHaveCafRefs -- Definitely safe -This information is used to build Static Reference Tables (see -simplStg/ComputeSRT.lhs). +-- CafInfo is used to build Static Reference Tables (see simplStg/SRT.lhs). -\begin{code} data CafInfo = MayHaveCafRefs -- either: -- (1) A function or static constructor @@ -476,97 +567,27 @@ data CafInfo | NoCafRefs -- A function or static constructor -- that refers to no CAFs. --- LATER: not sure how easy this is... --- | OneCafRef Id +mayHaveCafRefs MayHaveCafRefs = True +mayHaveCafRefs _ = False + +seqCaf c = c `seq` () + +pprCgInfo (CgInfo caf_info) = ppCafInfo caf_info +ppArity 0 = empty +ppArity n = hsep [ptext SLIT("__A"), int n] ppCafInfo NoCafRefs = ptext SLIT("__C") ppCafInfo MayHaveCafRefs = empty \end{code} - -%************************************************************************ -%* * -\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 +type CgInfoEnv = NameEnv CgInfo - -- 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 +lookupCgInfo :: NameEnv CgInfo -> Name -> CgInfo +lookupCgInfo env n = case lookupNameEnv env n of + Just info -> info + Nothing -> pprTrace "Urk! Not in CgInfo env" (ppr n) vanillaCgInfo \end{code} @@ -597,34 +618,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 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 @@ -653,22 +665,33 @@ work. data LBVarInfo = NoLBVarInfo - | IsOneShotLambda -- The lambda that binds this Id is applied - -- at most once + | LBVarInfo Type -- The lambda that binds this Id has this usage + -- annotation (i.e., if ==usOnce, then the + -- lambda is applied at most once). + -- The annotation's kind must be `$' -- HACK ALERT! placing this info here is a short-term hack, -- but it minimises changes to the rest of the compiler. -- Hack agreed by SLPJ/KSW 1999-04. + +seqLBVar l = l `seq` () \end{code} \begin{code} +hasNoLBVarInfo NoLBVarInfo = True +hasNoLBVarInfo other = False + noLBVarInfo = NoLBVarInfo -- not safe to print or parse LBVarInfo because it is not really a -- property of the definition, but a property of the context. pprLBVarInfo NoLBVarInfo = empty -pprLBVarInfo IsOneShotLambda = getPprStyle $ \ sty -> - if ifaceStyle sty then empty - else ptext SLIT("OneShot") +pprLBVarInfo (LBVarInfo u) | u `eqUsage` usOnce + = getPprStyle $ \ sty -> + if ifaceStyle sty + then empty + else ptext SLIT("OneShot") + | otherwise + = empty instance Outputable LBVarInfo where ppr = pprLBVarInfo @@ -676,3 +699,105 @@ instance Outputable LBVarInfo where instance Show LBVarInfo where showsPrec p c = showsPrecSDoc p (ppr c) \end{code} + + +%************************************************************************ +%* * +\subsection{Bulk operations on IdInfo} +%* * +%************************************************************************ + +@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, newDemandInfo = demand}) + | is_safe_occ && not (isStrictDmd demand) + = Nothing + | otherwise + = Just (info {occInfo = safe_occ, + newDemandInfo = Lazy}) + 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} + +\begin{code} +zapDemandInfo :: IdInfo -> Maybe IdInfo +zapDemandInfo info@(IdInfo {newDemandInfo = demand}) + | not (isStrictDmd demand) = Nothing + | otherwise = Just (info {newDemandInfo = Lazy}) +\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}