X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FIdInfo.lhs;h=cde3737301d594feab40e7cb70a7db99deaea1e8;hb=51a571c0f5b0201ea53bec60fcaafb78c01c017e;hp=10720f0588afb90540efb00d692249d56f6d25f3;hpb=2c8f04b5b883db74f449dfc8c224929fe28b027d;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs index 10720f0..cde3737 100644 --- a/ghc/compiler/basicTypes/IdInfo.lhs +++ b/ghc/compiler/basicTypes/IdInfo.lhs @@ -1,5 +1,5 @@ % -% (c) The GRASP/AQUA Project, Glasgow University, 1993-1996 +% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998 % \section[IdInfo]{@IdInfos@: Non-essential information about @Ids@} @@ -8,68 +8,143 @@ Haskell. [WDP 94/11]) \begin{code} module IdInfo ( + GlobalIdDetails(..), notGlobalId, -- Not abstract + IdInfo, -- Abstract + vanillaIdInfo, noTyGenIdInfo, noCafOrTyGenIdInfo, noCafIdInfo, + seqIdInfo, megaSeqIdInfo, - noIdInfo, - ppIdInfo, + -- Zapping + zapLamInfo, zapDemandInfo, + shortableIdInfo, copyIdInfo, -- Arity ArityInfo(..), - exactArity, atLeastArity, unknownArity, - arityInfo, setArityInfo, ppArityInfo, + exactArity, atLeastArity, unknownArity, hasArity, + arityInfo, setArityInfo, ppArityInfo, arityLowerBound, + + -- Strictness; imported from Demand + StrictnessInfo(..), + mkStrictnessInfo, noStrictnessInfo, + ppStrictnessInfo,isBottomingStrictness, + strictnessInfo, setStrictnessInfo, - -- Demand - DemandInfo, - noDemandInfo, mkDemandInfo, demandInfo, ppDemandInfo, setDemandInfo, willBeDemanded, - Demand(..), -- Non-abstract + -- Usage generalisation + TyGenInfo(..), + tyGenInfo, setTyGenInfo, + noTyGenInfo, isNoTyGenInfo, ppTyGenInfo, tyGenInfoString, - -- Strictness - StrictnessInfo(..), -- Non-abstract - workerExists, - mkStrictnessInfo, mkBottomStrictnessInfo, noStrictnessInfo, bottomIsGuaranteed, - strictnessInfo, ppStrictnessInfo, setStrictnessInfo, + -- Worker + WorkerInfo(..), workerExists, wrapperArity, workerId, + workerInfo, setWorkerInfo, ppWorkerInfo, -- Unfolding unfoldingInfo, setUnfoldingInfo, + -- DemandInfo + demandInfo, setDemandInfo, + -- Inline prags - InlinePragInfo(..), - inlinePragInfo, setInlinePragInfo, + InlinePragInfo(..), + inlinePragInfo, setInlinePragInfo, pprInlinePragInfo, + isNeverInlinePrag, neverInlinePrag, + + -- Occurrence info + OccInfo(..), isFragileOcc, isDeadOcc, isLoopBreaker, + InsideLam, OneBranch, insideLam, notInsideLam, oneBranch, notOneBranch, + occInfo, setOccInfo, -- Specialisation - IdSpecEnv, specInfo, setSpecInfo, + specInfo, setSpecInfo, - -- Update - UpdateInfo, UpdateSpec, - mkUpdateInfo, updateInfo, updateInfoMaybe, ppUpdateInfo, setUpdateInfo, + -- CAF info + CafInfo(..), cafInfo, setCafInfo, mayHaveCafRefs, ppCafInfo, - -- Arg usage - ArgUsageInfo, ArgUsage(..), ArgUsageType, - mkArgUsageInfo, argUsageInfo, setArgUsageInfo, getArgUsage, + -- Constructed Product Result Info + CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo, - -- FB type - FBTypeInfo, FBType(..), FBConsum(..), FBProd(..), - fbTypeInfo, ppFBTypeInfo, setFBTypeInfo, mkFBTypeInfo, getFBType + -- Lambda-bound variable info + LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo, hasNoLBVarInfo ) where #include "HsVersions.h" -import {-# SOURCE #-} CoreUnfold ( Unfolding, noUnfolding ) -import {-# SOURCE #-} CoreSyn ( CoreExpr ) - --- for mkdependHS, CoreSyn.hi-boot refers to it: -import BinderInfo ( BinderInfo ) +import CoreSyn +import Type ( Type, usOnce ) +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 Type ( usOnce, usMany ) +import Demand -- Lots of stuff +import Outputable +import Util ( seqList ) + +infixl 1 `setDemandInfo`, + `setTyGenInfo`, + `setStrictnessInfo`, + `setSpecInfo`, + `setArityInfo`, + `setInlinePragInfo`, + `setUnfoldingInfo`, + `setCprInfo`, + `setWorkerInfo`, + `setLBVarInfo`, + `setCafInfo`, + `setOccInfo` + -- infixl so you can say (id `set` a `set` b) +\end{code} -import SpecEnv ( SpecEnv, emptySpecEnv ) -import BasicTypes ( NewOrData ) +%************************************************************************ +%* * +\subsection{GlobalIdDetails +%* * +%************************************************************************ -import Demand -import Outputable +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. -import Char ( ord ) +\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 + + | 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 (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. @@ -80,94 +155,162 @@ the properties attached to the other. The @IdInfo@ gives information about the value, or definition, of the @Id@. It does {\em not} contain information about the @Id@'s usage -(except for @DemandInfo@? ToDo). +(except for @DemandInfo@? ToDo). (@lbvarInfo@ is also a marginal +case. KSW 1999-04). \begin{code} data IdInfo = IdInfo { - arityInfo :: ArityInfo, -- Its arity - - demandInfo :: DemandInfo, -- Whether or not it is definitely demanded - - specInfo :: IdSpecEnv, -- Specialisations of this function which exist - - strictnessInfo :: StrictnessInfo, -- Strictness properties - - unfoldingInfo :: Unfolding, -- Its unfolding; for locally-defined - -- things, this can *only* be NoUnfolding - - updateInfo :: UpdateInfo, -- Which args should be updated - - argUsageInfo :: ArgUsageInfo, -- how this Id uses its arguments - - fbTypeInfo :: FBTypeInfo, -- the Foldr/Build W/W property of this function. - - inlinePragInfo :: InlinePragInfo -- Inline pragmas + arityInfo :: ArityInfo, -- Its arity + demandInfo :: 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 + cafInfo :: CafInfo, -- whether it refers (indirectly) to any CAFs + cprInfo :: CprInfo, -- Function always constructs a product result + lbvarInfo :: LBVarInfo, -- Info about a lambda-bound variable + inlinePragInfo :: InlinePragInfo, -- Inline pragma + occInfo :: OccInfo -- How it occurs } + +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 + + seqCaf (cafInfo info) `seq` + seqCpr (cprInfo info) `seq` + seqLBVar (lbvarInfo info) `seq` + seqOccInfo (occInfo info) \end{code} Setters \begin{code} -setFBTypeInfo fb info = info { fbTypeInfo = fb } -setArgUsageInfo au info = info { argUsageInfo = au } -setUpdateInfo ud info = info { updateInfo = ud } -setDemandInfo dd info = info { demandInfo = dd } -setStrictnessInfo st info = info { strictnessInfo = st } -setSpecInfo sp info = info { specInfo = sp } -setArityInfo ar info = info { arityInfo = ar } -setInlinePragInfo pr info = info { inlinePragInfo = pr } -setUnfoldingInfo uf info = info { unfoldingInfo = uf } +setWorkerInfo info wk = wk `seq` info { workerInfo = wk } +setSpecInfo info sp = PSEQ sp (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 && 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 } + +setDemandInfo info dd = info { demandInfo = dd } +setArityInfo info ar = info { arityInfo = ar } +setCafInfo info cf = info { cafInfo = cf } +setCprInfo info cp = info { cprInfo = cp } +setLBVarInfo info lb = info { lbvarInfo = lb } \end{code} \begin{code} -noIdInfo = IdInfo { - arityInfo = UnknownArity, - demandInfo = UnknownDemand, - specInfo = emptySpecEnv, - strictnessInfo = NoStrictnessInfo, - unfoldingInfo = noUnfolding, - updateInfo = NoUpdateInfo, - argUsageInfo = NoArgUsageInfo, - fbTypeInfo = NoFBTypeInfo, - inlinePragInfo = NoPragmaInfo +vanillaIdInfo :: IdInfo +vanillaIdInfo + = IdInfo { + cafInfo = MayHaveCafRefs, -- Safe! + arityInfo = UnknownArity, + demandInfo = wwLazy, + specInfo = emptyCoreRules, + tyGenInfo = noTyGenInfo, + workerInfo = NoWorker, + strictnessInfo = NoStrictnessInfo, + unfoldingInfo = noUnfolding, + cprInfo = NoCPRInfo, + lbvarInfo = NoLBVarInfo, + inlinePragInfo = NoInlinePragInfo, + occInfo = NoOccInfo } -\end{code} -\begin{code} -ppIdInfo :: Bool -- True <=> print specialisations, please - -> IdInfo - -> SDoc - -ppIdInfo specs_please (IdInfo {arityInfo, updateInfo, strictnessInfo, demandInfo}) - = hsep [ - ppArityInfo arityInfo, - ppUpdateInfo updateInfo, - ppStrictnessInfo strictnessInfo, - ppDemandInfo demandInfo - ] +noTyGenIdInfo = vanillaIdInfo `setTyGenInfo` TyGenNever + -- Many built-in things have fixed types, so we shouldn't + -- run around generalising them + +noCafIdInfo = vanillaIdInfo `setCafInfo` NoCafRefs + -- Local things don't refer to Cafs + +noCafOrTyGenIdInfo = noTyGenIdInfo `setCafInfo` NoCafRefs + -- Most also guarantee not to refer to CAFs \end{code} + %************************************************************************ %* * \subsection[arity-IdInfo]{Arity info about an @Id@} %* * %************************************************************************ +For locally-defined Ids, the code generator maintains its own notion +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 + + | 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` () exactArity = ArityExactly atLeastArity = ArityAtLeast unknownArity = UnknownArity +arityLowerBound :: ArityInfo -> Arity +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("_A>_"), int arity] +ppArityInfo (ArityExactly arity) = hsep [ptext SLIT("__A"), int arity] +ppArityInfo (ArityAtLeast arity) = hsep [ptext SLIT("__AL"), int arity] \end{code} %************************************************************************ @@ -178,272 +321,396 @@ ppArityInfo (ArityAtLeast arity) = hsep [ptext SLIT("_A>_"), int arity] \begin{code} data InlinePragInfo - = NoPragmaInfo - - | IWantToBeINLINEd - - | IMustNotBeINLINEd -- Used by the simplifier to prevent looping - -- on recursive definitions - - | IMustBeINLINEd -- Absolutely must inline; used for PrimOps only + = 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 + + -- SEE COMMENTS WITH CoreUnfold.blackListed on the + -- exact significance of the IMustNotBeINLINEd pragma + +isNeverInlinePrag :: InlinePragInfo -> Bool +isNeverInlinePrag (IMustNotBeINLINEd _ Nothing) = True +isNeverInlinePrag other = False + +neverInlinePrag :: InlinePragInfo +neverInlinePrag = IMustNotBeINLINEd True{-should be False? --SDM -} Nothing + +instance Outputable InlinePragInfo where + -- 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} %************************************************************************ -%* * -\subsection[specialisation-IdInfo]{Specialisation info about an @Id@} -%* * +%* * +\subsection[TyGen-IdInfo]{Type generalisation info about an @Id@} +%* * %************************************************************************ -A @IdSpecEnv@ holds details of an @Id@'s specialisations. +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. -\begin{code} -type IdSpecEnv = SpecEnv CoreExpr -\end{code} +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). -For example, if \tr{f}'s @SpecEnv@ contains the mapping: -\begin{verbatim} - [List a, b] ===> (\d -> f' a b) -\end{verbatim} -then when we find an application of f to matching types, we simply replace -it by the matching RHS: -\begin{verbatim} - f (List Int) Bool ===> (\d -> f' Int Bool) -\end{verbatim} -All the stuff about how many dictionaries to discard, and what types -to apply the specialised function to, are handled by the fact that the -SpecEnv contains a template for the result of the specialisation. +To indicate this property, such identifiers are marked TyGenNever. -There is one more exciting case, which is dealt with in exactly the same -way. If the specialised value is unboxed then it is lifted at its -definition site and unlifted at its uses. For example: +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. - pi :: forall a. Num a => a +\begin{code} +data TyGenInfo + = NoTyGenInfo -- no restriction on type generalisation -might have a specialisation + | TyGenUInfo [Maybe Type] -- restrict generalisation of this Id to + -- preserve specified usage annotations - [Int#] ===> (case pi' of Lift pi# -> pi#) + | TyGenNever -- never generalise the type of this Id -where pi' :: Lift Int# is the specialised version of pi. + deriving ( Eq ) +\end{code} +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. + +\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 == usOnce = '1' -- chars with identity + | u == 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[strictness-IdInfo]{Strictness info about an @Id@} +\subsection[worker-IdInfo]{Worker 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). +If this Id has a worker then we store a reference to it. Worker +functions are generated by the worker/wrapper pass. This uses +information from the strictness and CPR analyses. -The list of @Demands@ specifies: (a)~the strictness properties -of a function's arguments; (b)~the {\em existence} of a ``worker'' -version of the function; and (c)~the type signature of that worker (if -it exists); i.e. its calling convention. +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. \begin{code} -data StrictnessInfo - = NoStrictnessInfo - - | BottomGuaranteed -- This Id guarantees never to return; - -- it is bottom regardless of its arguments. - -- Useful for "error" and other disguised - -- variants thereof. - - | StrictnessInfo [Demand] - Bool -- True <=> there is a worker. There might not be, 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. - - -- Worker's Id, if applicable, and a list of the constructors - -- mentioned by the wrapper. This is necessary so that the - -- renamer can slurp them in. Without this info, the renamer doesn't - -- know which data types to slurp in concretely. Remember, for - -- strict things we don't put the unfolding in the interface file, to save space. - -- This constructor list allows the renamer to behave much as if the - -- unfolding *was* in the interface file. -\end{code} -\begin{code} -mkStrictnessInfo :: [Demand] -> Bool -> StrictnessInfo - -mkStrictnessInfo xs has_wrkr - | all is_lazy xs = NoStrictnessInfo -- Uninteresting - | otherwise = StrictnessInfo xs has_wrkr - where - is_lazy (WwLazy False) = True -- NB "Absent" args do *not* count! - is_lazy _ = False -- (as they imply a worker) +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. -noStrictnessInfo = NoStrictnessInfo -mkBottomStrictnessInfo = BottomGuaranteed +seqWorker :: WorkerInfo -> () +seqWorker (HasWorker id _) = id `seq` () +seqWorker NoWorker = () -bottomIsGuaranteed BottomGuaranteed = True -bottomIsGuaranteed other = False +ppWorkerInfo NoWorker = empty +ppWorkerInfo (HasWorker wk_id _) = ptext SLIT("__P") <+> ppr wk_id -ppStrictnessInfo NoStrictnessInfo = empty -ppStrictnessInfo BottomGuaranteed = ptext SLIT("_bot_") - -ppStrictnessInfo (StrictnessInfo wrapper_args wrkr_maybe) - = hsep [ptext SLIT("_S_"), text (showList wrapper_args "")] -\end{code} +workerExists :: WorkerInfo -> Bool +workerExists NoWorker = False +workerExists (HasWorker _ _) = True +workerId :: WorkerInfo -> Id +workerId (HasWorker id _) = id -\begin{code} -workerExists :: StrictnessInfo -> Bool -workerExists (StrictnessInfo _ worker_exists) = worker_exists -workerExists other = False +wrapperArity :: WorkerInfo -> Arity +wrapperArity (HasWorker _ a) = a \end{code} %************************************************************************ %* * -\subsection[demand-IdInfo]{Demand info about an @Id@} +\subsection[CAF-IdInfo]{CAF-related information} %* * %************************************************************************ -Whether a value is certain to be demanded or not. (This is the -information that is computed by the ``front-end'' of the strictness -analyser.) - -This information is only used within a module, it is not exported -(obviously). +This information is used to build Static Reference Tables (see +simplStg/ComputeSRT.lhs). \begin{code} -data DemandInfo - = UnknownDemand - | DemandedAsPer Demand -\end{code} +data CafInfo + = MayHaveCafRefs -- either: + -- (1) A function or static constructor + -- that refers to one or more CAFs, + -- (2) A real live CAF -\begin{code} -noDemandInfo = UnknownDemand + | NoCafRefs -- A function or static constructor + -- that refers to no CAFs. + +-- LATER: not sure how easy this is... +-- | OneCafRef Id -mkDemandInfo :: Demand -> DemandInfo -mkDemandInfo demand = DemandedAsPer demand -willBeDemanded :: DemandInfo -> Bool -willBeDemanded (DemandedAsPer demand) = isStrict demand -willBeDemanded _ = False +mayHaveCafRefs MayHaveCafRefs = True +mayHaveCafRefs _ = False -ppDemandInfo UnknownDemand = text "{-# L #-}" -ppDemandInfo (DemandedAsPer info) = hsep [text "{-#", text (showList [info] ""), text "#-}"] +seqCaf c = c `seq` () + +ppCafInfo NoCafRefs = ptext SLIT("__C") +ppCafInfo MayHaveCafRefs = empty \end{code} %************************************************************************ %* * -\subsection[update-IdInfo]{Update-analysis info about an @Id@} +\subsection[cpr-IdInfo]{Constructed Product Result info about an @Id@} %* * %************************************************************************ +If the @Id@ is a function then it may have CPR info. A CPR analysis +phase detects whether: + +\begin{enumerate} +\item +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. +\item +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. +\end{enumerate} + +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. + \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] +data CprInfo + = NoCPRInfo + | 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} -mkUpdateInfo = SomeUpdateInfo +seqCpr :: CprInfo -> () +seqCpr ReturnsCPR = () +seqCpr NoCPRInfo = () -updateInfoMaybe NoUpdateInfo = Nothing -updateInfoMaybe (SomeUpdateInfo []) = Nothing -updateInfoMaybe (SomeUpdateInfo u) = Just u -\end{code} +noCprInfo = NoCPRInfo -Text instance so that the update annotations can be read in. +ppCprInfo NoCPRInfo = empty +ppCprInfo ReturnsCPR = ptext SLIT("__M") -\begin{code} -ppUpdateInfo NoUpdateInfo = empty -ppUpdateInfo (SomeUpdateInfo []) = empty -ppUpdateInfo (SomeUpdateInfo spec) = (<>) (ptext SLIT("_U_ ")) (hcat (map int spec)) +instance Outputable CprInfo where + ppr = ppCprInfo + +instance Show CprInfo where + showsPrec p c = showsPrecSDoc p (ppr c) \end{code} + %************************************************************************ %* * -\subsection[argUsage-IdInfo]{Argument Usage info about an @Id@} +\subsection[lbvar-IdInfo]{Lambda-bound var info about an @Id@} %* * %************************************************************************ -\begin{code} -data ArgUsageInfo - = NoArgUsageInfo - | SomeArgUsageInfo ArgUsageType +If the @Id@ is a lambda-bound variable then it may have lambda-bound +var info. The usage analysis (UsageSP) detects whether the lambda +binding this var is a ``one-shot'' lambda; that is, whether it is +applied at most once. -data ArgUsage = ArgUsage Int -- number of arguments (is linear!) - | UnknownArgUsage - -type ArgUsageType = [ArgUsage] -- c_1 -> ... -> BLOB -\end{code} +This information may be useful in optimisation, as computations may +safely be floated inside such a lambda without risk of duplicating +work. \begin{code} -mkArgUsageInfo [] = NoArgUsageInfo -mkArgUsageInfo au = SomeArgUsageInfo au - -getArgUsage :: ArgUsageInfo -> ArgUsageType -getArgUsage NoArgUsageInfo = [] -getArgUsage (SomeArgUsageInfo u) = u +data LBVarInfo + = NoLBVarInfo + + | 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} -{- UNUSED: -ppArgUsageInfo NoArgUsageInfo = empty -ppArgUsageInfo (SomeArgUsageInfo aut) = (<>) (ptext SLIT("_L_ ")) (ppArgUsageType aut) --} - -ppArgUsage (ArgUsage n) = int n -ppArgUsage (UnknownArgUsage) = char '-' - -ppArgUsageType aut = hcat - [ char '"' , - hcat (punctuate comma (map ppArgUsage aut)), - char '"' ] +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 (LBVarInfo u) | u == usOnce + = getPprStyle $ \ sty -> + if ifaceStyle sty + then empty + else ptext SLIT("OneShot") + | otherwise + = empty + +instance Outputable LBVarInfo where + ppr = pprLBVarInfo + +instance Show LBVarInfo where + showsPrec p c = showsPrecSDoc p (ppr c) \end{code} %************************************************************************ %* * -\subsection[FBType-IdInfo]{Type of an expression through Foldr/build's eyes} +\subsection{Bulk operations on IdInfo} %* * %************************************************************************ -\begin{code} -data FBTypeInfo - = NoFBTypeInfo - | SomeFBTypeInfo FBType - -data FBType = FBType [FBConsum] FBProd deriving (Eq) +@zapLamInfo@ is used for lambda binders that turn out to to be +part of an unsaturated lambda -data FBConsum = FBGoodConsum | FBBadConsum deriving(Eq) -data FBProd = FBGoodProd | FBBadProd deriving(Eq) +\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} \begin{code} -mkFBTypeInfo = SomeFBTypeInfo - -getFBType :: FBTypeInfo -> Maybe FBType -getFBType NoFBTypeInfo = Nothing -getFBType (SomeFBTypeInfo u) = Just u +zapDemandInfo :: IdInfo -> Maybe IdInfo +zapDemandInfo info@(IdInfo {demandInfo = demand}) + | not (isStrict demand) = Nothing + | otherwise = Just (info {demandInfo = wwLazy}) \end{code} -\begin{code} -ppFBTypeInfo NoFBTypeInfo = empty -ppFBTypeInfo (SomeFBTypeInfo (FBType cons prod)) - = (<>) (ptext SLIT("_F_ ")) (ppFBType cons prod) -ppFBType cons prod = hcat - ([ char '"' ] ++ map ppCons cons ++ [ char '-', ppProd prod, char '"' ]) - where - ppCons FBGoodConsum = char 'G' - ppCons FBBadConsum = char 'B' - ppProd FBGoodProd = char 'G' - ppProd FBBadProd = char 'B' +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}