X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FIdInfo.lhs;h=f73ba4f65d78131255862ddb9bd01f592f8af413;hb=219fbeccb52d15bacc54f88d422b172866dbd154;hp=2843e29ded18e20a2ff42656ed7a91b1b3655f6e;hpb=fda89b29c748c6cd2fe1fdb477d5c0e8f7d32b90;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs index 2843e29..f73ba4f 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@} @@ -7,340 +7,399 @@ Haskell. [WDP 94/11]) \begin{code} -#include "HsVersions.h" - module IdInfo ( IdInfo, -- Abstract - noIdInfo, - ppIdInfo, - applySubstToIdInfo, apply_to_IdInfo, -- not for general use, please + vanillaIdInfo, mkIdInfo, seqIdInfo, megaSeqIdInfo, + + -- Zapping + zapFragileInfo, zapLamInfo, zapSpecPragInfo, copyIdInfo, + + -- Flavour + IdFlavour(..), flavourInfo, + setNoDiscardInfo, + ppFlavourInfo, + -- Arity ArityInfo(..), - exactArity, atLeastArity, unknownArity, - arityInfo, addArityInfo, ppArityInfo, + exactArity, atLeastArity, unknownArity, hasArity, + arityInfo, setArityInfo, ppArityInfo, arityLowerBound, + + -- Strictness; imported from Demand + StrictnessInfo(..), + mkStrictnessInfo, noStrictnessInfo, + ppStrictnessInfo,isBottomingStrictness, + + strictnessInfo, setStrictnessInfo, + + -- Worker + WorkerInfo(..), workerExists, wrapperArity, workerId, + workerInfo, setWorkerInfo, ppWorkerInfo, - DemandInfo, - noDemandInfo, mkDemandInfo, demandInfo, ppDemandInfo, addDemandInfo, willBeDemanded, + -- Unfolding + unfoldingInfo, setUnfoldingInfo, - StrictnessInfo(..), -- Non-abstract - Demand(..), NewOrData, -- Non-abstract + -- DemandInfo + demandInfo, setDemandInfo, - workerExists, - mkStrictnessInfo, mkBottomStrictnessInfo, noStrictnessInfo, bottomIsGuaranteed, - strictnessInfo, ppStrictnessInfo, addStrictnessInfo, + -- Inline prags + InlinePragInfo(..), + inlinePragInfo, setInlinePragInfo, pprInlinePragInfo, + isNeverInlinePrag, neverInlinePrag, - unfoldInfo, addUnfoldInfo, + -- Occurrence info + OccInfo(..), isFragileOccInfo, + InsideLam, OneBranch, insideLam, notInsideLam, oneBranch, notOneBranch, + occInfo, setOccInfo, - specInfo, addSpecInfo, + -- Specialisation + specInfo, setSpecInfo, - UpdateInfo, SYN_IE(UpdateSpec), - mkUpdateInfo, updateInfo, updateInfoMaybe, ppUpdateInfo, addUpdateInfo, + -- Update + UpdateInfo, UpdateSpec, + mkUpdateInfo, updateInfo, updateInfoMaybe, ppUpdateInfo, setUpdateInfo, - DeforestInfo(..), - deforestInfo, ppDeforestInfo, addDeforestInfo, + -- CAF info + CafInfo(..), cafInfo, setCafInfo, ppCafInfo, - ArgUsageInfo, ArgUsage(..), SYN_IE(ArgUsageType), - mkArgUsageInfo, argUsageInfo, addArgUsageInfo, getArgUsage, + -- Constructed Product Result Info + CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo, - FBTypeInfo, FBType(..), FBConsum(..), FBProd(..), - fbTypeInfo, ppFBTypeInfo, addFBTypeInfo, mkFBTypeInfo, getFBType + -- Lambda-bound variable info + LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo ) where -IMP_Ubiq() -IMPORT_1_3(Char(toLower)) - -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201 -IMPORT_DELOOPER(IdLoop) -- IdInfo is a dependency-loop ranch, and - -- we break those loops by using IdLoop and - -- *not* importing much of anything else, - -- except from the very general "utils". -#else -import {-# SOURCE #-} SpecEnv -import {-# SOURCE #-} Id -import {-# SOURCE #-} CoreUnfold -import {-# SOURCE #-} StdIdInfo -#endif - -import BasicTypes ( NewOrData ) -import CmdLineOpts ( opt_OmitInterfacePragmas ) - -import Demand -import Maybes ( firstJust ) -import Outputable ( ifaceStyle, PprStyle(..), Outputable(..){-instances-} ) -import Pretty -import PprType () -import Unique ( pprUnique ) -import Util ( mapAccumL, panic, assertPanic, pprPanic ) - -#ifdef REALLY_HASKELL_1_3 -ord = fromEnum :: Char -> Int -#endif - -showTypeCategory = panic "IdInfo.showTypeCategory" +#include "HsVersions.h" + + +import CoreSyn +import PrimOp ( PrimOp ) +import Var ( Id ) +import BasicTypes ( OccInfo(..), isFragileOccInfo, seqOccInfo, + InsideLam, insideLam, notInsideLam, + OneBranch, oneBranch, notOneBranch, + Arity + ) +import DataCon ( DataCon ) +import FieldLabel ( FieldLabel ) +import Demand -- Lots of stuff +import Outputable +import Maybe ( isJust ) + +infixl 1 `setUpdateInfo`, + `setDemandInfo`, + `setStrictnessInfo`, + `setSpecInfo`, + `setArityInfo`, + `setInlinePragInfo`, + `setUnfoldingInfo`, + `setCprInfo`, + `setWorkerInfo`, + `setCafInfo`, + `setOccInfo` + -- infixl so you can say (id `set` a `set` b) \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. + 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. 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 -- Its arity - - DemandInfo -- Whether or not it is definitely - -- demanded - - SpecEnv -- Specialisations of this function which exist - - StrictnessInfo -- Strictness properties - - Unfolding -- Its unfolding; for locally-defined - -- things, this can *only* be NoUnfolding - - UpdateInfo -- Which args should be updated - - DeforestInfo -- Whether its definition should be - -- unfolded during deforestation - - ArgUsageInfo -- how this Id uses its arguments - - FBTypeInfo -- the Foldr/Build W/W property of this function. + = IdInfo { + flavourInfo :: IdFlavour, -- NOT OPTIONAL + arityInfo :: ArityInfo, -- Its arity + demandInfo :: Demand, -- Whether or not it is definitely demanded + specInfo :: CoreRules, -- 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 + 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 + = seqFlavour (flavourInfo info) `seq` + seqArity (arityInfo info) `seq` + seqDemand (demandInfo info) `seq` + seqRules (specInfo info) `seq` + seqStrictnessInfo (strictnessInfo info) `seq` + seqWorker (workerInfo info) `seq` + +-- seqUnfolding (unfoldingInfo info) `seq` +-- Omitting this improves runtimes a little, presumably because +-- some unfoldings are not calculated at all + + seqCaf (cafInfo info) `seq` + seqCpr (cprInfo info) `seq` + seqLBVar (lbvarInfo info) `seq` + seqOccInfo (occInfo info) \end{code} -\begin{code} -noIdInfo = IdInfo UnknownArity UnknownDemand nullSpecEnv NoStrictnessInfo noUnfolding - NoUpdateInfo Don'tDeforest NoArgUsageInfo NoFBTypeInfo -\end{code} +Setters -Simply turgid. But BE CAREFUL: don't @apply_to_Id@ if that @Id@ -will in turn @apply_to_IdInfo@ of the self-same @IdInfo@. (A very -nasty loop, friends...) \begin{code} -apply_to_IdInfo ty_fn idinfo@(IdInfo arity demand spec strictness unfold - update deforest arg_usage fb_ww) - | isNullSpecEnv spec - = idinfo +setWorkerInfo info wk = wk `seq` info { workerInfo = wk } +setSpecInfo info sp = PSEQ sp (info { specInfo = sp }) +setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr } +setOccInfo info oc = oc `seq` info { occInfo = oc } +setStrictnessInfo info st = st `seq` info { strictnessInfo = st } + -- Try to avoid spack leaks by seq'ing + +setUnfoldingInfo info uf + | 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 - = panic "IdInfo:apply_to_IdInfo" + -- We do *not* seq on the unfolding info, For some reason, doing so + -- actually increases residency significantly. + = info { unfoldingInfo = uf } + +setUpdateInfo info ud = info { updateInfo = ud } +setDemandInfo info dd = info { demandInfo = dd } +setArityInfo info ar = info { arityInfo = ar } +setCafInfo info cf = info { cafInfo = cf } +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 \end{code} -Variant of the same thing for the typechecker. -\begin{code} -applySubstToIdInfo s0 (IdInfo arity demand spec strictness unfold - update deforest arg_usage fb_ww) - = panic "IdInfo:applySubstToIdInfo" -\end{code} \begin{code} -ppIdInfo :: PprStyle - -> Bool -- True <=> print specialisations, please - -> IdInfo - -> Doc - -ppIdInfo sty specs_please - (IdInfo arity demand specenv strictness unfold update deforest arg_usage fbtype) - = hsep [ - -- order is important!: - ppArityInfo sty arity, - ppUpdateInfo sty update, - ppDeforestInfo sty deforest, - - ppStrictnessInfo sty strictness, - - if specs_please - then empty -- ToDo -- sty (not (isDataCon for_this_id)) - -- better_id_fn inline_env (mEnvToList specenv) - else empty, - - -- DemandInfo needn't be printed since it has no effect on interfaces - ppDemandInfo sty demand, - ppFBTypeInfo sty fbtype - ] +vanillaIdInfo :: IdInfo +vanillaIdInfo = mkIdInfo VanillaId + +mkIdInfo :: IdFlavour -> IdInfo +mkIdInfo flv = IdInfo { + flavourInfo = flv, + arityInfo = UnknownArity, + demandInfo = wwLazy, + specInfo = emptyCoreRules, + workerInfo = NoWorker, + strictnessInfo = NoStrictnessInfo, + unfoldingInfo = noUnfolding, + updateInfo = NoUpdateInfo, + cafInfo = MayHaveCafRefs, + cprInfo = NoCPRInfo, + lbvarInfo = NoLBVarInfo, + inlinePragInfo = NoInlinePragInfo, + occInfo = NoOccInfo + } \end{code} + %************************************************************************ %* * -\subsection[arity-IdInfo]{Arity info about an @Id@} +\subsection{Flavour} %* * %************************************************************************ \begin{code} -data ArityInfo - = UnknownArity -- No idea - | ArityExactly Int -- Arity is exactly this - | ArityAtLeast Int -- Arity is this or greater +data IdFlavour + = VanillaId -- Most Ids are like this + | DataConId DataCon -- The Id for a data constructor *worker* + | DataConWrapId DataCon -- The Id for a data constructor *wrapper* + -- [the only reasons we need to know is so that + -- a) we can suppress printing a definition in the interface file + -- b) when typechecking a pattern we can get from the + -- Id back to the data con] + | PrimOpId PrimOp -- The Id for a primitive operator + | RecordSelId FieldLabel -- The Id for a record selector + | SpecPragmaId -- Don't discard these + | NoDiscardId -- Don't discard these either + +ppFlavourInfo :: IdFlavour -> SDoc +ppFlavourInfo VanillaId = empty +ppFlavourInfo (DataConId _) = ptext SLIT("[DataCon]") +ppFlavourInfo (DataConWrapId _) = ptext SLIT("[DataConWrapper]") +ppFlavourInfo (PrimOpId _) = ptext SLIT("[PrimOp]") +ppFlavourInfo (RecordSelId _) = ptext SLIT("[RecSel]") +ppFlavourInfo SpecPragmaId = ptext SLIT("[SpecPrag]") +ppFlavourInfo NoDiscardId = ptext SLIT("[NoDiscard]") + +seqFlavour :: IdFlavour -> () +seqFlavour f = f `seq` () \end{code} -\begin{code} -exactArity = ArityExactly -atLeastArity = ArityAtLeast -unknownArity = UnknownArity - -arityInfo (IdInfo arity _ _ _ _ _ _ _ _) = arity +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. -addArityInfo (IdInfo _ a c d e f g h i) arity = IdInfo arity a c d e f g h i - -ppArityInfo sty UnknownArity = empty -ppArityInfo sty (ArityExactly arity) = hsep [ptext SLIT("_A_"), int arity] -ppArityInfo sty (ArityAtLeast arity) = hsep [ptext SLIT("_A>_"), int arity] -\end{code} %************************************************************************ %* * -\subsection[demand-IdInfo]{Demand info about an @Id@} +\subsection[arity-IdInfo]{Arity info about an @Id@} %* * %************************************************************************ -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). +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 DemandInfo - = UnknownDemand - | DemandedAsPer Demand -\end{code} +data ArityInfo + = UnknownArity -- No idea -\begin{code} -noDemandInfo = UnknownDemand + | 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. -mkDemandInfo :: Demand -> DemandInfo -mkDemandInfo demand = DemandedAsPer demand + | ArityAtLeast Arity -- Arity is this or greater. We attach this arity to + -- 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 ) -willBeDemanded :: DemandInfo -> Bool -willBeDemanded (DemandedAsPer demand) = isStrict demand -willBeDemanded _ = False -\end{code} +seqArity :: ArityInfo -> () +seqArity a = arityLowerBound a `seq` () -\begin{code} -demandInfo (IdInfo _ demand _ _ _ _ _ _ _) = demand +exactArity = ArityExactly +atLeastArity = ArityAtLeast +unknownArity = UnknownArity + +arityLowerBound :: ArityInfo -> Arity +arityLowerBound UnknownArity = 0 +arityLowerBound (ArityAtLeast n) = n +arityLowerBound (ArityExactly n) = n -addDemandInfo (IdInfo a _ c d e f g h i) demand = IdInfo a demand c d e f g h i +hasArity :: ArityInfo -> Bool +hasArity UnknownArity = False +hasArity other = True -ppDemandInfo PprInterface _ = empty -ppDemandInfo sty UnknownDemand = text "{-# L #-}" -ppDemandInfo sty (DemandedAsPer info) = hsep [text "{-#", text (showList [info] ""), text "#-}"] +ppArityInfo UnknownArity = empty +ppArityInfo (ArityExactly arity) = hsep [ptext SLIT("__A"), int arity] +ppArityInfo (ArityAtLeast arity) = hsep [ptext SLIT("__AL"), int arity] \end{code} %************************************************************************ %* * -\subsection[specialisation-IdInfo]{Specialisation info about an @Id@} +\subsection{Inline-pragma information} %* * %************************************************************************ -See SpecEnv.lhs - \begin{code} -specInfo (IdInfo _ _ spec _ _ _ _ _ _) = spec - -addSpecInfo id_info spec | isNullSpecEnv spec = id_info -addSpecInfo (IdInfo a b _ d e f g h i) spec = IdInfo a b spec d e f g h i +data InlinePragInfo + = NoInlinePragInfo + | IMustNotBeINLINEd Bool -- True <=> came from an INLINE prag, False <=> came from a NOINLINE prag + (Maybe Int) -- Phase number from pragma, if any + deriving( Eq ) + -- The True, Nothing case doesn't need to be recorded + + -- 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[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). - -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. +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. -\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} +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} -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. It had better be the same as the arity of the wrapper + -- at the moment it is spat into the interface file. + -- This Arity just lets us make a (hopefully redundant) sanity check -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 -strictnessInfo (IdInfo _ _ _ strict _ _ _ _ _) = strict +noWorkerInfo = NoWorker -addStrictnessInfo id_info NoStrictnessInfo = id_info -addStrictnessInfo (IdInfo a b d _ e f g h i) strict = IdInfo a b d strict e f g h i +workerExists :: WorkerInfo -> Bool +workerExists NoWorker = False +workerExists (HasWorker _ _) = True -ppStrictnessInfo sty NoStrictnessInfo = empty -ppStrictnessInfo sty BottomGuaranteed = ptext SLIT("_bot_") +workerId :: WorkerInfo -> Id +workerId (HasWorker id _) = id -ppStrictnessInfo sty (StrictnessInfo wrapper_args wrkr_maybe) - = hsep [ptext SLIT("_S_"), text (showList wrapper_args "")] -\end{code} - - -\begin{code} -workerExists :: StrictnessInfo -> Bool -workerExists (StrictnessInfo _ worker_exists) = worker_exists -workerExists other = False +wrapperArity :: WorkerInfo -> Arity +wrapperArity (HasWorker _ a) = a \end{code} %************************************************************************ %* * -\subsection[unfolding-IdInfo]{Unfolding info about an @Id@} -%* * -%************************************************************************ - -\begin{code} -unfoldInfo (IdInfo _ _ _ _ unfolding _ _ _ _) = unfolding - -addUnfoldInfo (IdInfo a b d e _ f g h i) uf = IdInfo a b d e uf f g h i -\end{code} - -%************************************************************************ -%* * \subsection[update-IdInfo]{Update-analysis info about an @Id@} %* * %************************************************************************ @@ -367,138 +426,247 @@ updateInfoMaybe (SomeUpdateInfo u) = Just u Text instance so that the update annotations can be read in. \begin{code} -#ifdef REALLY_HASKELL_1_3 -instance Read UpdateInfo where -#else -instance Text UpdateInfo where -#endif - readsPrec p s | null s = panic "IdInfo: empty update pragma?!" - | otherwise = [(SomeUpdateInfo (map ok_digit s),"")] - where - ok_digit c | c >= '0' && c <= '2' = ord c - ord '0' - | otherwise = panic "IdInfo: not a digit while reading update pragma" - -updateInfo (IdInfo _ _ _ _ _ update _ _ _) = update - -addUpdateInfo id_info NoUpdateInfo = id_info -addUpdateInfo (IdInfo a b d e f _ g h i) upd_info = IdInfo a b d e f upd_info g h i - -ppUpdateInfo sty NoUpdateInfo = empty -ppUpdateInfo sty (SomeUpdateInfo []) = empty -ppUpdateInfo sty (SomeUpdateInfo spec) = (<>) (ptext SLIT("_U_ ")) (hcat (map int spec)) +ppUpdateInfo NoUpdateInfo = empty +ppUpdateInfo (SomeUpdateInfo []) = empty +ppUpdateInfo (SomeUpdateInfo spec) = (<>) (ptext SLIT("__UA ")) (hcat (map int spec)) + -- was "__U "; changed to avoid conflict with unfoldings. KSW 1999-07. \end{code} %************************************************************************ -%* * -\subsection[deforest-IdInfo]{Deforestation info about an @Id@} -%* * +%* * +\subsection[CAF-IdInfo]{CAF-related information} +%* * %************************************************************************ -The deforest info says whether this Id is to be unfolded during -deforestation. Therefore, when the deforest pragma is true, we must -also have the unfolding information available for this Id. +This information is used to build Static Reference Tables (see +simplStg/ComputeSRT.lhs). \begin{code} -data DeforestInfo - = Don'tDeforest -- just a bool, might extend this - | DoDeforest -- later. - -- deriving (Eq, Ord) -\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} -deforestInfo (IdInfo _ _ _ _ _ _ deforest _ _) = deforest + | NoCafRefs -- A function or static constructor + -- that refers to no CAFs. -addDeforestInfo id_info Don'tDeforest = id_info -addDeforestInfo (IdInfo a b d e f g _ h i) deforest = IdInfo a b d e f g deforest h i +-- LATER: not sure how easy this is... +-- | OneCafRef Id -ppDeforestInfo sty Don'tDeforest = empty -ppDeforestInfo sty DoDeforest = ptext SLIT("_DEFOREST_") + +seqCaf c = c `seq` () + +ppCafInfo NoCafRefs = ptext SLIT("__C") +ppCafInfo MayHaveCafRefs = empty \end{code} + %************************************************************************ %* * -\subsection[argUsage-IdInfo]{Argument Usage info about an @Id@} +\subsection[cpr-IdInfo]{Constructed Product Result info about an @Id@} %* * %************************************************************************ -\begin{code} -data ArgUsageInfo - = NoArgUsageInfo - | SomeArgUsageInfo ArgUsageType - -- ??? deriving (Eq, Ord) - -data ArgUsage = ArgUsage Int -- number of arguments (is linear!) - | UnknownArgUsage -type ArgUsageType = [ArgUsage] -- c_1 -> ... -> BLOB -\end{code} +If the @Id@ is a function then it may have CPR info. A CPR analysis +phase detects whether: -\begin{code} -mkArgUsageInfo [] = NoArgUsageInfo -mkArgUsageInfo au = SomeArgUsageInfo au +\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} -getArgUsage :: ArgUsageInfo -> ArgUsageType -getArgUsage NoArgUsageInfo = [] -getArgUsage (SomeArgUsageInfo u) = u +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 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} -argUsageInfo (IdInfo _ _ _ _ _ _ _ au _) = au +seqCpr :: CprInfo -> () +seqCpr ReturnsCPR = () +seqCpr NoCPRInfo = () -addArgUsageInfo id_info NoArgUsageInfo = id_info -addArgUsageInfo (IdInfo a b d e f g h _ i) au_info = IdInfo a b d e f g h au_info i +noCprInfo = NoCPRInfo -ppArgUsageInfo sty NoArgUsageInfo = empty -ppArgUsageInfo sty (SomeArgUsageInfo aut) = (<>) (ptext SLIT("_L_ ")) (ppArgUsageType aut) +ppCprInfo NoCPRInfo = empty +ppCprInfo ReturnsCPR = ptext SLIT("__M") -ppArgUsage (ArgUsage n) = int n -ppArgUsage (UnknownArgUsage) = char '-' +instance Outputable CprInfo where + ppr = ppCprInfo -ppArgUsageType aut = hcat - [ char '"' , - hcat (punctuate comma (map ppArgUsage aut)), - char '"' ] +instance Show CprInfo where + showsPrec p c = showsPrecSDoc p (ppr c) \end{code} + %************************************************************************ %* * -\subsection[FBType-IdInfo]{Type of an expression through Foldr/build's eyes} +\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. 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. + +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 FBTypeInfo - = NoFBTypeInfo - | SomeFBTypeInfo FBType +data LBVarInfo + = NoLBVarInfo -data FBType = FBType [FBConsum] FBProd deriving (Eq) + | IsOneShotLambda -- The lambda that binds this Id is applied + -- at most once + -- 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. -data FBConsum = FBGoodConsum | FBBadConsum deriving(Eq) -data FBProd = FBGoodProd | FBBadProd deriving(Eq) +seqLBVar l = l `seq` () \end{code} \begin{code} -mkFBTypeInfo = SomeFBTypeInfo +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") + +instance Outputable LBVarInfo where + ppr = pprLBVarInfo -getFBType :: FBTypeInfo -> Maybe FBType -getFBType NoFBTypeInfo = Nothing -getFBType (SomeFBTypeInfo u) = Just u +instance Show LBVarInfo where + showsPrec p c = showsPrecSDoc p (ppr c) \end{code} + +%************************************************************************ +%* * +\subsection{Bulk operations on IdInfo} +%* * +%************************************************************************ + +zapFragileInfo is used when cloning binders, mainly in the +simplifier. We must forget about used-once information because that +isn't necessarily correct in the transformed program. +Also forget specialisations and unfoldings because they would need +substitution to be correct. (They get pinned back on separately.) + \begin{code} -fbTypeInfo (IdInfo _ _ _ _ _ _ _ _ fb) = fb +zapFragileInfo :: IdInfo -> Maybe IdInfo +zapFragileInfo info@(IdInfo {occInfo = occ, + workerInfo = wrkr, + specInfo = rules, + unfoldingInfo = unfolding}) + | not (isFragileOccInfo occ) + -- We must forget about whether it was marked safe-to-inline, + -- because that isn't necessarily true in the simplified expression. + -- This is important because expressions may be re-simplified + -- We don't zap deadness or loop-breaker-ness. + -- The latter is important because it tells MkIface not to + -- spit out an inlining for the thing. The former doesn't + -- seem so important, but there's no harm. + + && isEmptyCoreRules rules + -- Specialisations would need substituting. They get pinned + -- back on separately. + + && not (workerExists wrkr) + + && not (hasUnfolding unfolding) + -- This is very important; occasionally a let-bound binder is used + -- as a binder in some lambda, in which case its unfolding is utterly + -- bogus. Also the unfolding uses old binders so if we left it we'd + -- have to substitute it. Much better simply to give the Id a new + -- unfolding each time, which is what the simplifier does. + = Nothing -addFBTypeInfo id_info NoFBTypeInfo = id_info -addFBTypeInfo (IdInfo a b d e f g h i _) fb_info = IdInfo a b d e f g h i fb_info + | otherwise + = Just (info {occInfo = robust_occ_info, + workerInfo = noWorkerInfo, + specInfo = emptyCoreRules, + unfoldingInfo = noUnfolding}) + where + -- It's important to keep the loop-breaker info, + -- because the substitution doesn't remember it. + robust_occ_info = case occ of + OneOcc _ _ -> NoOccInfo + other -> occ +\end{code} -ppFBTypeInfo sty NoFBTypeInfo = empty -ppFBTypeInfo sty (SomeFBTypeInfo (FBType cons prod)) - = (<>) (ptext SLIT("_F_ ")) (ppFBType cons prod) +@zapLamInfo@ is used for lambda binders that turn out to to be +part of an unsaturated lambda -ppFBType cons prod = hcat - ([ char '"' ] ++ map ppCons cons ++ [ char '-', ppProd prod, char '"' ]) +\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 - ppCons FBGoodConsum = char 'G' - ppCons FBBadConsum = char 'B' - ppProd FBGoodProd = char 'G' - ppProd FBBadProd = char 'B' + -- The "unsafe" occ info is the ones that say I'm not in a lambda + -- because that might not be true for an unsaturated lambda + is_safe_occ = case occ of + OneOcc in_lam once -> in_lam + other -> True + + safe_occ = case occ of + OneOcc _ once -> OneOcc insideLam once + other -> occ +\end{code} + + +copyIdInfo is used when shorting out a top-level binding + f_local = BIG + f = f_local +where f is exported. We are going to swizzle it around to + f = BIG + f_local = f +but 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, and the result is attached to f + +\begin{code} +copyIdInfo :: IdInfo -- From + -> IdInfo -- To + -> IdInfo -- To, updated with stuff from From; except flavour unchanged +copyIdInfo from to = from { flavourInfo = flavourInfo to, + specInfo = specInfo to, + inlinePragInfo = inlinePragInfo to + } + -- It's important to preserve the inline pragma on 'f'; e.g. consider + -- {-# NOINLINE f #-} + -- f = local + -- + -- similarly, transformation rules may be attached to f + -- and we want to preserve them. + -- + -- On the other hand, we want the strictness info from f_local. \end{code}