X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FIdInfo.lhs;h=54578ae2f4f8aa3d03e4ee291a5854e76a437a29;hb=8e67f5502e2e316245806ee3735a2f41a844b611;hp=9e3f04f0a5ce60d5bac3446b5f889303a466eb8e;hpb=d0ba2040b0dfefea0c30b109fb58a405e46d878e;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs index 9e3f04f..54578ae 100644 --- a/ghc/compiler/basicTypes/IdInfo.lhs +++ b/ghc/compiler/basicTypes/IdInfo.lhs @@ -8,327 +8,434 @@ Haskell. [WDP 94/11]) \begin{code} module IdInfo ( + GlobalIdDetails(..), notGlobalId, -- Not abstract + IdInfo, -- Abstract + vanillaIdInfo, noCafIdInfo, + seqIdInfo, megaSeqIdInfo, - noIdInfo, + -- Zapping + zapLamInfo, zapDemandInfo, + shortableIdInfo, copyIdInfo, -- Arity - ArityInfo(..), - exactArity, atLeastArity, unknownArity, - arityInfo, setArityInfo, ppArityInfo, arityLowerBound, - - -- Strictness - StrictnessInfo(..), -- Non-abstract - mkStrictnessInfo, - noStrictnessInfo, strictnessInfo, - ppStrictnessInfo, setStrictnessInfo, - isBottomingStrictness, appIsBottom, + ArityInfo, + unknownArity, + arityInfo, setArityInfo, ppArityInfo, + + -- New demand and strictness info + newStrictnessInfo, setNewStrictnessInfo, + newDemandInfo, setNewDemandInfo, pprNewStrictness, + setAllStrictnessInfo, + +#ifdef OLD_STRICTNESS + -- Strictness; imported from Demand + StrictnessInfo(..), + mkStrictnessInfo, noStrictnessInfo, + ppStrictnessInfo,isBottomingStrictness, +#endif -- Worker - WorkerInfo, workerExists, - workerInfo, setWorkerInfo, + WorkerInfo(..), workerExists, wrapperArity, workerId, + workerInfo, setWorkerInfo, ppWorkerInfo, -- Unfolding - unfoldingInfo, setUnfoldingInfo, + unfoldingInfo, setUnfoldingInfo, setUnfoldingInfoLazily, - -- DemandInfo +#ifdef OLD_STRICTNESS + -- Old DemandInfo and StrictnessInfo demandInfo, setDemandInfo, + strictnessInfo, setStrictnessInfo, + cprInfoFromNewStrictness, + oldStrictnessFromNew, newStrictnessFromOld, + oldDemand, newDemand, + + -- Constructed Product Result Info + CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo, +#endif -- Inline prags - InlinePragInfo(..), OccInfo(..), - inlinePragInfo, setInlinePragInfo, notInsideLambda, + InlinePragInfo, + inlinePragInfo, setInlinePragInfo, - -- Specialisation - IdSpecEnv, specInfo, setSpecInfo, + -- Occurrence info + OccInfo(..), isFragileOcc, isDeadOcc, isLoopBreaker, + InsideLam, OneBranch, insideLam, notInsideLam, oneBranch, notOneBranch, + occInfo, setOccInfo, - -- Update - UpdateInfo, UpdateSpec, - mkUpdateInfo, updateInfo, updateInfoMaybe, ppUpdateInfo, setUpdateInfo, + -- Specialisation + specInfo, setSpecInfo, -- CAF info - CafInfo(..), cafInfo, setCafInfo, ppCafInfo, + CafInfo(..), cafInfo, ppCafInfo, setCafInfo, mayHaveCafRefs, - -- Constructed Product Result Info - CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo + -- Lambda-bound variable info + LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo, hasNoLBVarInfo ) where #include "HsVersions.h" -import {-# SOURCE #-} CoreUnfold ( Unfolding, noUnfolding ) -import {-# SOURCE #-} CoreSyn ( CoreExpr ) - +import CoreSyn +import Class ( Class ) +import PrimOp ( PrimOp ) import Var ( Id ) -import SpecEnv ( SpecEnv, emptySpecEnv ) -import Demand ( Demand, isLazy, wwLazy, pprDemands ) +import BasicTypes ( OccInfo(..), isFragileOcc, isDeadOcc, seqOccInfo, isLoopBreaker, + InsideLam, insideLam, notInsideLam, + OneBranch, oneBranch, notOneBranch, + Arity, + Activation(..) + ) +import DataCon ( DataCon ) +import TyCon ( TyCon, FieldLabel ) +import ForeignCall ( ForeignCall ) +import NewDemand import Outputable - -import Maybe ( isJust ) - +import Maybe ( isJust ) + +#ifdef OLD_STRICTNESS +import Name ( Name ) +import Demand hiding( Demand, seqDemand ) +import qualified Demand +import Util ( listLengthCmp ) +import List ( replicate ) +#endif + +-- infixl so you can say (id `set` a `set` b) +infixl 1 `setSpecInfo`, + `setArityInfo`, + `setInlinePragInfo`, + `setUnfoldingInfo`, + `setWorkerInfo`, + `setLBVarInfo`, + `setOccInfo`, + `setCafInfo`, + `setNewStrictnessInfo`, + `setAllStrictnessInfo`, + `setNewDemandInfo` +#ifdef OLD_STRICTNESS + , `setCprInfo` + , `setDemandInfo` + , `setStrictnessInfo` +#endif \end{code} -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. - -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. +%************************************************************************ +%* * +\subsection{New strictness info} +%* * +%************************************************************************ -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). +To be removed later \begin{code} -data IdInfo - = IdInfo { - arityInfo :: ArityInfo, -- Its arity - demandInfo :: Demand, -- Whether or not it is definitely demanded - specInfo :: IdSpecEnv, -- Specialisations of this function which exist - 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 - inlinePragInfo :: !InlinePragInfo -- Inline pragmas - } +-- setAllStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo +-- Set old and new strictness info +setAllStrictnessInfo info Nothing + = info { newStrictnessInfo = Nothing +#ifdef OLD_STRICTNESS + , strictnessInfo = NoStrictnessInfo + , cprInfo = NoCPRInfo +#endif + } + +setAllStrictnessInfo info (Just sig) + = info { newStrictnessInfo = Just sig +#ifdef OLD_STRICTNESS + , strictnessInfo = oldStrictnessFromNew sig + , cprInfo = cprInfoFromNewStrictness sig +#endif + } + +seqNewStrictnessInfo Nothing = () +seqNewStrictnessInfo (Just ty) = seqStrictSig ty + +pprNewStrictness Nothing = empty +pprNewStrictness (Just sig) = ftext FSLIT("Str:") <+> ppr sig + +#ifdef OLD_STRICTNESS +oldStrictnessFromNew :: StrictSig -> Demand.StrictnessInfo +oldStrictnessFromNew sig = mkStrictnessInfo (map oldDemand dmds, isBotRes res_info) + where + (dmds, res_info) = splitStrictSig sig + +cprInfoFromNewStrictness :: StrictSig -> CprInfo +cprInfoFromNewStrictness sig = case strictSigResInfo sig of + RetCPR -> ReturnsCPR + other -> NoCPRInfo + +newStrictnessFromOld :: Name -> Arity -> Demand.StrictnessInfo -> CprInfo -> StrictSig +newStrictnessFromOld name arity (Demand.StrictnessInfo ds res) cpr + | listLengthCmp ds arity /= GT -- length ds <= arity + -- Sometimes the old strictness analyser has more + -- demands than the arity justifies + = mk_strict_sig name arity $ + mkTopDmdType (map newDemand ds) (newRes res cpr) + +newStrictnessFromOld name arity other cpr + = -- Either no strictness info, or arity is too small + -- In either case we can't say anything useful + mk_strict_sig name arity $ + mkTopDmdType (replicate arity lazyDmd) (newRes False cpr) + +mk_strict_sig name arity dmd_ty + = WARN( arity /= dmdTypeDepth dmd_ty, ppr name <+> (ppr arity $$ ppr dmd_ty) ) + mkStrictSig dmd_ty + +newRes True _ = BotRes +newRes False ReturnsCPR = retCPR +newRes False NoCPRInfo = TopRes + +newDemand :: Demand.Demand -> NewDemand.Demand +newDemand (WwLazy True) = Abs +newDemand (WwLazy False) = lazyDmd +newDemand WwStrict = evalDmd +newDemand (WwUnpack unpk ds) = Eval (Prod (map newDemand ds)) +newDemand WwPrim = lazyDmd +newDemand WwEnum = evalDmd + +oldDemand :: NewDemand.Demand -> Demand.Demand +oldDemand Abs = WwLazy True +oldDemand Top = WwLazy False +oldDemand Bot = WwStrict +oldDemand (Box Bot) = WwStrict +oldDemand (Box Abs) = WwLazy False +oldDemand (Box (Eval _)) = WwStrict -- Pass box only +oldDemand (Defer d) = WwLazy False +oldDemand (Eval (Prod ds)) = WwUnpack True (map oldDemand ds) +oldDemand (Eval (Poly _)) = WwStrict +oldDemand (Call _) = WwStrict + +#endif /* OLD_STRICTNESS */ \end{code} -Setters \begin{code} -setUpdateInfo ud info = info { updateInfo = ud } -setDemandInfo dd info = info { demandInfo = dd } -setStrictnessInfo st info = info { strictnessInfo = st } -setWorkerInfo wk info = info { workerInfo = wk } -setSpecInfo sp info = info { specInfo = sp } -setArityInfo ar info = info { arityInfo = ar } -setInlinePragInfo pr info = info { inlinePragInfo = pr } -setUnfoldingInfo uf info = info { unfoldingInfo = uf } -setCafInfo cf info = info { cafInfo = cf } -setCprInfo cp info = info { cprInfo = cp } +seqNewDemandInfo Nothing = () +seqNewDemandInfo (Just dmd) = seqDemand dmd \end{code} -\begin{code} -noIdInfo = IdInfo { - arityInfo = UnknownArity, - demandInfo = wwLazy, - specInfo = emptySpecEnv, - strictnessInfo = NoStrictnessInfo, - workerInfo = noWorkerInfo, - unfoldingInfo = noUnfolding, - updateInfo = NoUpdateInfo, - cafInfo = MayHaveCafRefs, - cprInfo = NoCPRInfo, - inlinePragInfo = NoInlinePragInfo - } -\end{code} - %************************************************************************ %* * -\subsection[arity-IdInfo]{Arity info about an @Id@} +\subsection{GlobalIdDetails %* * %************************************************************************ -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!) +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 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 - - -ppArityInfo UnknownArity = empty -ppArityInfo (ArityExactly arity) = hsep [ptext SLIT("__A"), int arity] -ppArityInfo (ArityAtLeast arity) = hsep [ptext SLIT("__AL"), int arity] +data GlobalIdDetails + = VanillaGlobal -- Imported from elsewhere, a default method Id. + + | RecordSelId TyCon FieldLabel -- The Id for a record selector + + | DataConWorkId 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] + + | ClassOpId Class -- An operation of a class + + | 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 (DataConWorkId _) = ptext SLIT("[DataCon]") + ppr (DataConWrapId _) = ptext SLIT("[DataConWrapper]") + ppr (ClassOpId _) = ptext SLIT("[ClassOp]") + ppr (PrimOpId _) = ptext SLIT("[PrimOp]") + ppr (FCallId _) = ptext SLIT("[ForeignCall]") + ppr (RecordSelId _ _) = ptext SLIT("[RecSel]") \end{code} + %************************************************************************ %* * -\subsection{Inline-pragma information} +\subsection{The main IdInfo type} %* * %************************************************************************ -\begin{code} -data InlinePragInfo - = NoInlinePragInfo - - | IAmASpecPragmaId -- Used for spec-pragma Ids; don't discard or inline +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. - | IWantToBeINLINEd -- User INLINE pragma - | IMustNotBeINLINEd -- User NOINLINE pragma +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. - | IAmALoopBreaker -- Used by the occurrence analyser to mark loop-breakers - -- in a group of recursive definitions +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). (@lbvarInfo@ is also a marginal +case. KSW 1999-04). - | ICanSafelyBeINLINEd -- Used by the occurrence analyser to mark things - -- that manifesly occur once, not inside SCCs, - -- not in constructor arguments +\begin{code} +data IdInfo + = IdInfo { + arityInfo :: !ArityInfo, -- Its arity + specInfo :: CoreRules, -- Specialisations of this function which exist +#ifdef OLD_STRICTNESS + cprInfo :: CprInfo, -- Function always constructs a product result + demandInfo :: Demand.Demand, -- Whether or not it is definitely demanded + strictnessInfo :: StrictnessInfo, -- Strictness properties +#endif + workerInfo :: WorkerInfo, -- Pointer to Worker Function + unfoldingInfo :: Unfolding, -- Its unfolding + cafInfo :: CafInfo, -- CAF info + lbvarInfo :: LBVarInfo, -- Info about a lambda-bound variable + 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 :: Maybe Demand -- Similarly we want to know if there's no + -- known demand yet, for when we are looking for + -- CPR info + } - OccInfo -- Says whether the occurrence is inside a lambda - -- If so, must only substitute WHNFs +seqIdInfo :: IdInfo -> () +seqIdInfo (IdInfo {}) = () - Bool -- False <=> occurs in more than one case branch - -- If so, there's a code-duplication issue +megaSeqIdInfo :: IdInfo -> () +megaSeqIdInfo info + = seqRules (specInfo info) `seq` + seqWorker (workerInfo info) `seq` - | IAmDead -- Marks unused variables. Sometimes useful for - -- lambda and case-bound variables. +-- Omitting this improves runtimes a little, presumably because +-- some unfoldings are not calculated at all +-- seqUnfolding (unfoldingInfo info) `seq` - | IMustBeINLINEd -- Absolutely must inline; used for PrimOps and - -- constructors only. + seqNewDemandInfo (newDemandInfo info) `seq` + seqNewStrictnessInfo (newStrictnessInfo info) `seq` -instance Outputable InlinePragInfo where - ppr NoInlinePragInfo = empty - ppr IMustBeINLINEd = ptext SLIT("__UU") - ppr IWantToBeINLINEd = ptext SLIT("__U") - 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") - ppr IAmASpecPragmaId = ptext SLIT("__US") +#ifdef OLD_STRICTNESS + Demand.seqDemand (demandInfo info) `seq` + seqStrictnessInfo (strictnessInfo info) `seq` + seqCpr (cprInfo info) `seq` +#endif -instance Show InlinePragInfo where - showsPrec p prag = showsPrecSDoc p (ppr prag) + seqCaf (cafInfo info) `seq` + seqLBVar (lbvarInfo info) `seq` + seqOccInfo (occInfo info) \end{code} -The @IMustNotBeDiscarded@ 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. +Setters \begin{code} -data OccInfo - = StrictOcc -- Occurs syntactically strictly; - -- i.e. in a function position or case scrutinee - - | LazyOcc -- Not syntactically strict (*even* that of a strict function) - -- or in a case branch where there's more than one alternative - - | 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. +setWorkerInfo info wk = wk `seq` info { workerInfo = wk } +setSpecInfo info sp = sp `seq` info { specInfo = sp } +setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr } +setOccInfo info oc = oc `seq` info { occInfo = oc } +#ifdef OLD_STRICTNESS +setStrictnessInfo info st = st `seq` info { strictnessInfo = st } +#endif + -- Try to avoid spack leaks by seq'ing + +setUnfoldingInfoLazily info uf -- Lazy variant to avoid looking at the + = -- unfolding of an imported Id unless necessary + info { unfoldingInfo = uf } -- (In this case the demand-zapping is redundant.) + +setUnfoldingInfo info uf + -- We do *not* seq on the unfolding info, For some reason, doing so + -- actually increases residency significantly. + = info { unfoldingInfo = uf } + +#ifdef OLD_STRICTNESS +setDemandInfo info dd = info { demandInfo = dd } +setCprInfo info cp = info { cprInfo = cp } +#endif + +setArityInfo info ar = info { arityInfo = ar } +setCafInfo info caf = info { cafInfo = caf } + +setLBVarInfo info lb = {-lb `seq`-} info { lbvarInfo = lb } + +setNewDemandInfo info dd = dd `seq` info { newDemandInfo = dd } +setNewStrictnessInfo info dd = dd `seq` info { newStrictnessInfo = dd } +\end{code} -instance Outputable OccInfo where - ppr StrictOcc = text "s" - ppr LazyOcc = empty - ppr InsideLam = text "l" +\begin{code} +vanillaIdInfo :: IdInfo +vanillaIdInfo + = IdInfo { + cafInfo = vanillaCafInfo, + arityInfo = unknownArity, +#ifdef OLD_STRICTNESS + cprInfo = NoCPRInfo, + demandInfo = wwLazy, + strictnessInfo = NoStrictnessInfo, +#endif + specInfo = emptyCoreRules, + workerInfo = NoWorker, + unfoldingInfo = noUnfolding, + lbvarInfo = NoLBVarInfo, + inlinePragInfo = AlwaysActive, + occInfo = NoOccInfo, + newDemandInfo = Nothing, + newStrictnessInfo = Nothing + } -notInsideLambda :: OccInfo -> Bool -notInsideLambda StrictOcc = True -notInsideLambda LazyOcc = True -notInsideLambda InsideLam = False +noCafIdInfo = vanillaIdInfo `setCafInfo` NoCafRefs + -- Used for built-in type Ids in MkId. \end{code} + %************************************************************************ %* * -\subsection[specialisation-IdInfo]{Specialisation info about an @Id@} +\subsection[arity-IdInfo]{Arity info about an @Id@} %* * %************************************************************************ -A @IdSpecEnv@ holds details of an @Id@'s specialisations. +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} -type IdSpecEnv = SpecEnv CoreExpr -\end{code} - -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. +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. -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: + -- The arity might increase later in the compilation process, if + -- an extra lambda floats up to the binding site. - pi :: forall a. Num a => a - -might have a specialisation - - [Int#] ===> (case pi' of Lift pi# -> pi#) - -where pi' :: Lift Int# is the specialised version of pi. +unknownArity = 0 :: Arity +ppArityInfo 0 = empty +ppArityInfo n = hsep [ptext SLIT("Arity"), int n] +\end{code} %************************************************************************ %* * -\subsection[strictness-IdInfo]{Strictness info about an @Id@} +\subsection{Inline-pragma information} %* * %************************************************************************ -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 +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} -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} %************************************************************************ %* * @@ -338,75 +445,65 @@ ppStrictnessInfo (StrictnessInfo wrapper_args bot) 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. +information from strictness analysis. 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} +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. -type WorkerInfo = Maybe Id +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). -{- UNUSED: -mkWorkerInfo :: Id -> WorkerInfo -mkWorkerInfo wk_id = Just wk_id +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". -ppWorkerInfo Nothing = empty -ppWorkerInfo (Just wk_id) = ppr wk_id --} +\begin{code} -noWorkerInfo = Nothing +data WorkerInfo = NoWorker + | HasWorker Id Arity + -- The Arity is the arity of the *wrapper* at the moment of the + -- w/w split. See notes above. -workerExists :: Maybe Id -> Bool -workerExists = isJust -\end{code} +seqWorker :: WorkerInfo -> () +seqWorker (HasWorker id a) = id `seq` a `seq` () +seqWorker NoWorker = () +ppWorkerInfo NoWorker = empty +ppWorkerInfo (HasWorker wk_id _) = ptext SLIT("__P") <+> ppr wk_id -%************************************************************************ -%* * -\subsection[update-IdInfo]{Update-analysis info about an @Id@} -%* * -%************************************************************************ +workerExists :: WorkerInfo -> Bool +workerExists NoWorker = False +workerExists (HasWorker _ _) = True -\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} - -\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("__U ")) (hcat (map int spec)) -\end{code} %************************************************************************ %* * -\subsection[CAF-IdInfo]{CAF-related information} +\subsection[CG-IdInfo]{Code generator-related information} %* * %************************************************************************ -This information is used to build Static Reference Tables (see -simplStg/ComputeSRT.lhs). - \begin{code} +-- CafInfo is used to build Static Reference Tables (see simplStg/SRT.lhs). + data CafInfo = MayHaveCafRefs -- either: -- (1) A function or static constructor @@ -416,11 +513,14 @@ data CafInfo | NoCafRefs -- A function or static constructor -- that refers to no CAFs. --- LATER: not sure how easy this is... --- | OneCafRef Id +vanillaCafInfo = MayHaveCafRefs -- Definitely safe +mayHaveCafRefs MayHaveCafRefs = True +mayHaveCafRefs _ = False -ppCafInfo NoCafRefs = ptext SLIT("__C") +seqCaf c = c `seq` () + +ppCafInfo NoCafRefs = ptext SLIT("NoCafRefs") ppCafInfo MayHaveCafRefs = empty \end{code} @@ -449,43 +549,175 @@ function has the CPR property and which components of the result are also CPRs. \begin{code} +#ifdef OLD_STRICTNESS 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 - | CPRInfo [CprInfo] - --- e.g. const 5 == CPRInfo [NoCPRInfo] --- == __M(-) --- \x -> (5, --- (x, --- 5, --- x) --- ) --- CPRInfo [CPRInfo [NoCPRInfo], --- CPRInfo [NoCprInfo, --- CPRInfo [NoCPRInfo], --- NoCPRInfo] --- ] --- __M((-)(-(-)-)-) -\end{code} + -- We used to keep nested info about sub-components, but + -- we never used it so I threw it away -\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 instance Show CprInfo where showsPrec p c = showsPrecSDoc p (ppr c) +#endif \end{code} +%************************************************************************ +%* * +\subsection[lbvar-IdInfo]{Lambda-bound var info about an @Id@} +%* * +%************************************************************************ + +If the @Id@ is a lambda-bound variable then it may have lambda-bound +var info. Sometimes we know whether the lambda binding this var is a +``one-shot'' lambda; that is, whether it is applied at most once. + +This information may be useful in optimisation, as computations may +safely be floated inside such a lambda without risk of duplicating +work. + +\begin{code} +data LBVarInfo = NoLBVarInfo + | IsOneShotLambda -- The lambda is applied at most once). + +seqLBVar l = l `seq` () +\end{code} + +\begin{code} +hasNoLBVarInfo NoLBVarInfo = True +hasNoLBVarInfo IsOneShotLambda = False + +noLBVarInfo = NoLBVarInfo + +pprLBVarInfo NoLBVarInfo = empty +pprLBVarInfo IsOneShotLambda = ptext SLIT("OneShot") + +instance Outputable LBVarInfo where + ppr = pprLBVarInfo + +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 occ && is_safe_dmd demand + = Nothing + | otherwise + = Just (info {occInfo = safe_occ, newDemandInfo = Nothing}) + where + -- The "unsafe" occ info is the ones that say I'm not in a lambda + -- because that might not be true for an unsaturated lambda + is_safe_occ (OneOcc in_lam once) = in_lam + is_safe_occ other = True + + safe_occ = case occ of + OneOcc _ once -> OneOcc insideLam once + other -> occ + + is_safe_dmd Nothing = True + is_safe_dmd (Just dmd) = not (isStrictDmd dmd) +\end{code} + +\begin{code} +zapDemandInfo :: IdInfo -> Maybe IdInfo +zapDemandInfo info@(IdInfo {newDemandInfo = dmd}) + | isJust dmd = Just (info {newDemandInfo = Nothing}) + | otherwise = Nothing +\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 { newStrictnessInfo = newStrictnessInfo f_local, +#ifdef OLD_STRICTNESS + strictnessInfo = strictnessInfo f_local, + cprInfo = cprInfo f_local, +#endif + workerInfo = workerInfo f_local + } +\end{code}