X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FIdInfo.lhs;h=f2084c8265835f0080d2c089c06e2161a04e9bbe;hb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;hp=40b3c1ff7d8451830cd57847718a896a51596a4f;hpb=7a3bd641457666e10d0a47be9f22762e03defbf0;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs index 40b3c1f..f2084c8 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,73 +7,53 @@ Haskell. [WDP 94/11]) \begin{code} -#include "HsVersions.h" - module IdInfo ( IdInfo, -- Abstract noIdInfo, ppIdInfo, - applySubstToIdInfo, apply_to_IdInfo, -- not for general use, please + -- Arity ArityInfo(..), exactArity, atLeastArity, unknownArity, - arityInfo, addArityInfo, ppArityInfo, - - DemandInfo, - noDemandInfo, mkDemandInfo, demandInfo, ppDemandInfo, addDemandInfo, willBeDemanded, + arityInfo, setArityInfo, ppArityInfo, arityLowerBound, + -- Strictness StrictnessInfo(..), -- Non-abstract - Demand(..), -- Non-abstract - wwLazy, wwStrict, wwUnpack, wwPrim, wwEnum, + workerExists, mkStrictnessInfo, mkBottomStrictnessInfo, + noStrictnessInfo, bottomIsGuaranteed, strictnessInfo, + ppStrictnessInfo, setStrictnessInfo, - getWorkerId_maybe, - workerExists, - mkStrictnessInfo, mkBottomStrictnessInfo, noStrictnessInfo, bottomIsGuaranteed, - strictnessInfo, ppStrictnessInfo, addStrictnessInfo, + -- Unfolding + unfoldingInfo, setUnfoldingInfo, - unfoldInfo, addUnfoldInfo, + -- DemandInfo + demandInfo, setDemandInfo, - specInfo, addSpecInfo, + -- Inline prags + InlinePragInfo(..), OccInfo(..), + inlinePragInfo, setInlinePragInfo, notInsideLambda, - UpdateInfo, SYN_IE(UpdateSpec), - mkUpdateInfo, updateInfo, updateInfoMaybe, ppUpdateInfo, addUpdateInfo, + -- Specialisation + IdSpecEnv, specInfo, setSpecInfo, - DeforestInfo(..), - deforestInfo, ppDeforestInfo, addDeforestInfo, + -- Update + UpdateInfo, UpdateSpec, + mkUpdateInfo, updateInfo, updateInfoMaybe, ppUpdateInfo, setUpdateInfo, - ArgUsageInfo, ArgUsage(..), SYN_IE(ArgUsageType), - mkArgUsageInfo, argUsageInfo, addArgUsageInfo, getArgUsage, - - FBTypeInfo, FBType(..), FBConsum(..), FBProd(..), - fbTypeInfo, ppFBTypeInfo, addFBTypeInfo, mkFBTypeInfo, getFBType + -- CAF info + CafInfo(..), cafInfo, setCafInfo, ppCafInfo, ) where -IMP_Ubiq() -IMPORT_1_3(Char(toLower)) - -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". - -import Type ( eqSimpleTy, splitFunTyExpandingDicts ) -import CmdLineOpts ( opt_OmitInterfacePragmas ) +#include "HsVersions.h" -import Demand -import Maybes ( firstJust ) -import Outputable ( ifPprInterface, Outputable(..){-instances-} ) -import PprStyle ( PprStyle(..) ) -import Pretty -import Unique ( pprUnique ) -import Util ( mapAccumL, panic, assertPanic, pprPanic ) -#ifdef REALLY_HASKELL_1_3 -ord = fromEnum :: Char -> Int -#endif +import {-# SOURCE #-} CoreUnfold ( Unfolding, noUnfolding ) +import {-# SOURCE #-} CoreSyn ( CoreExpr ) -applySubstToTy = panic "IdInfo.applySubstToTy" -showTypeCategory = panic "IdInfo.showTypeCategory" +import SpecEnv ( SpecEnv, emptySpecEnv ) +import Demand ( Demand, isLazy, wwLazy, pprDemands ) +import Outputable \end{code} An @IdInfo@ gives {\em optional} information about an @Id@. If @@ -90,131 +70,62 @@ The @IdInfo@ gives information about the value, or definition, of the \begin{code} data IdInfo - = IdInfo - ArityInfo -- Its arity - - DemandInfo -- Whether or not it is definitely - -- demanded - - SpecEnv - -- Specialisations of this function which exist - - (StrictnessInfo Id) - -- Strictness properties, notably - -- how to conjure up "worker" functions - - 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 { + 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 + unfoldingInfo :: Unfolding, -- Its unfolding + updateInfo :: UpdateInfo, -- Which args should be updated + cafInfo :: CafInfo, + inlinePragInfo :: !InlinePragInfo -- Inline pragmas + } \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 - | otherwise - = panic "IdInfo:apply_to_IdInfo" -{- LATER: - let - new_spec = apply_spec spec - - -- NOT a good idea: - -- apply_strict strictness `thenLft` \ new_strict -> - -- apply_wrap wrap `thenLft` \ new_wrap -> - in - IdInfo arity demand new_spec strictness unfold - update deforest arg_usage fb_ww - where - apply_spec (SpecEnv is) - = SpecEnv (map do_one is) - where - do_one (SpecInfo ty_maybes ds spec_id) - = --apply_to_Id ty_fn spec_id `thenLft` \ new_spec_id -> - SpecInfo (map apply_to_maybe ty_maybes) ds spec_id - where - apply_to_maybe Nothing = Nothing - apply_to_maybe (Just ty) = Just (ty_fn ty) --} - -{- NOT a good idea; - apply_strict info@NoStrictnessInfo = returnLft info - apply_strict BottomGuaranteed = ??? - apply_strict (StrictnessInfo wrap_arg_info id_maybe) - = (case id_maybe of - Nothing -> returnLft Nothing - Just xx -> applySubstToId subst xx `thenLft` \ new_xx -> - returnLft (Just new_xx) - ) `thenLft` \ new_id_maybe -> - returnLft (StrictnessInfo wrap_arg_info new_id_maybe) --} +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 } +setCafInfo cf info = info { cafInfo = cf } \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" -{- LATER: - case (apply_spec s0 spec) of { (s1, new_spec) -> - (s1, IdInfo arity demand new_spec strictness unfold update deforest arg_usage fb_ww) } - where - apply_spec s0 (SpecEnv is) - = case (mapAccumL do_one s0 is) of { (s1, new_is) -> - (s1, SpecEnv new_is) } - where - do_one s0 (SpecInfo ty_maybes ds spec_id) - = case (mapAccumL apply_to_maybe s0 ty_maybes) of { (s1, new_maybes) -> - (s1, SpecInfo new_maybes ds spec_id) } - where - apply_to_maybe s0 Nothing = (s0, Nothing) - apply_to_maybe s0 (Just ty) - = case (applySubstToTy s0 ty) of { (s1, new_ty) -> - (s1, Just new_ty) } --} +noIdInfo = IdInfo { + arityInfo = UnknownArity, + demandInfo = wwLazy, + specInfo = emptySpecEnv, + strictnessInfo = NoStrictnessInfo, + unfoldingInfo = noUnfolding, + updateInfo = NoUpdateInfo, + cafInfo = MayHaveCafRefs, + inlinePragInfo = NoInlinePragInfo + } \end{code} \begin{code} -ppIdInfo :: PprStyle - -> Bool -- True <=> print specialisations, please - -> IdInfo - -> Pretty - -ppIdInfo sty specs_please - (IdInfo arity demand specenv strictness unfold update deforest arg_usage fbtype) - = ppCat [ - -- order is important!: - ppArityInfo sty arity, - ppUpdateInfo sty update, - ppDeforestInfo sty deforest, - - ppStrictnessInfo sty strictness, - - if specs_please - then ppNil -- ToDo -- sty (not (isDataCon for_this_id)) - -- better_id_fn inline_env (mEnvToList specenv) - else ppNil, - - -- DemandInfo needn't be printed since it has no effect on interfaces - ppDemandInfo sty demand, - ppFBTypeInfo sty fbtype +ppIdInfo :: IdInfo -> SDoc +ppIdInfo (IdInfo {arityInfo, + demandInfo, + specInfo, + strictnessInfo, + unfoldingInfo, + updateInfo, + cafInfo, + inlinePragInfo}) + = hsep [ + ppArityInfo arityInfo, + ppUpdateInfo updateInfo, + ppStrictnessInfo strictnessInfo, + ppr demandInfo, + ppCafInfo cafInfo + -- Inline pragma printed out with all binders; see PprCore.pprIdBndr ] \end{code} @@ -224,66 +135,112 @@ ppIdInfo sty specs_please %* * %************************************************************************ +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 -\end{code} -\begin{code} exactArity = ArityExactly atLeastArity = ArityAtLeast unknownArity = UnknownArity -arityInfo (IdInfo arity _ _ _ _ _ _ _ _) = arity +arityLowerBound :: ArityInfo -> Int +arityLowerBound UnknownArity = 0 +arityLowerBound (ArityAtLeast n) = n +arityLowerBound (ArityExactly n) = n -addArityInfo id_info UnknownArity = id_info -addArityInfo (IdInfo _ a c d e f g h i) arity = IdInfo arity a c d e f g h i -ppArityInfo sty UnknownArity = ppNil -ppArityInfo sty (ArityExactly arity) = ppCat [ppPStr SLIT("_A_"), ppInt arity] -ppArityInfo sty (ArityAtLeast arity) = ppCat [ppPStr SLIT("_A>_"), ppInt arity] +ppArityInfo UnknownArity = empty +ppArityInfo (ArityExactly arity) = hsep [ptext SLIT("__A"), int arity] +ppArityInfo (ArityAtLeast arity) = hsep [ptext SLIT("__AL"), int arity] \end{code} %************************************************************************ %* * -\subsection[demand-IdInfo]{Demand info about an @Id@} +\subsection{Inline-pragma 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.) +\begin{code} +data InlinePragInfo + = NoInlinePragInfo -This information is only used within a module, it is not exported -(obviously). + | IAmASpecPragmaId -- Used for spec-pragma Ids; don't discard or inline -\begin{code} -data DemandInfo - = UnknownDemand - | DemandedAsPer Demand -\end{code} + | IWantToBeINLINEd -- User INLINE pragma + | IMustNotBeINLINEd -- User NOINLINE pragma -\begin{code} -noDemandInfo = UnknownDemand + | IAmALoopBreaker -- Used by the occurrence analyser to mark loop-breakers + -- in a group of recursive definitions + + | ICanSafelyBeINLINEd -- Used by the occurrence analyser to mark things + -- that manifesly occur once, not inside SCCs, + -- not in constructor arguments + + OccInfo -- Says whether the occurrence is inside a lambda + -- If so, must only substitute WHNFs + + Bool -- False <=> occurs in more than one case branch + -- If so, there's a code-duplication issue + + | IAmDead -- Marks unused variables. Sometimes useful for + -- lambda and case-bound variables. -mkDemandInfo :: Demand -> DemandInfo -mkDemandInfo demand = DemandedAsPer demand + | IMustBeINLINEd -- Absolutely must inline; used for PrimOps and + -- constructors only. -willBeDemanded :: DemandInfo -> Bool -willBeDemanded (DemandedAsPer demand) = isStrict demand -willBeDemanded _ = False +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 _ _) = ptext SLIT("__Us") + ppr IAmASpecPragmaId = ptext SLIT("__US") + +instance Show InlinePragInfo where + showsPrec p prag = showsPrecSDoc p (ppr prag) \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. + \begin{code} -demandInfo (IdInfo _ demand _ _ _ _ _ _ _) = demand +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. + +instance Outputable OccInfo where + ppr StrictOcc = text "s" + ppr LazyOcc = empty + ppr InsideLam = text "l" -addDemandInfo (IdInfo a _ c d e f g h i) demand = IdInfo a demand c d e f g h i -ppDemandInfo PprInterface _ = ppNil -ppDemandInfo sty UnknownDemand = ppStr "{-# L #-}" -ppDemandInfo sty (DemandedAsPer info) = ppCat [ppStr "{-#", ppStr (showList [info] ""), ppStr "#-}"] +notInsideLambda :: OccInfo -> Bool +notInsideLambda StrictOcc = True +notInsideLambda LazyOcc = True +notInsideLambda InsideLam = False \end{code} %************************************************************************ @@ -292,15 +249,39 @@ ppDemandInfo sty (DemandedAsPer info) = ppCat [ppStr "{-#", ppStr (showList [inf %* * %************************************************************************ -See SpecEnv.lhs +A @IdSpecEnv@ holds details of an @Id@'s specialisations. \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 +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. + +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: + + 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. + + + %************************************************************************ %* * \subsection[strictness-IdInfo]{Strictness info about an @Id@} @@ -318,7 +299,7 @@ version of the function; and (c)~the type signature of that worker (if it exists); i.e. its calling convention. \begin{code} -data StrictnessInfo bdee +data StrictnessInfo = NoStrictnessInfo | BottomGuaranteed -- This Id guarantees never to return; @@ -326,21 +307,28 @@ data StrictnessInfo bdee -- Useful for "error" and other disguised -- variants thereof. - | StrictnessInfo [Demand] -- The main stuff; see below. - (Maybe bdee) -- Worker's Id, if applicable. - -- (It may not be applicable because the strictness info - -- might say just "SSS" or something; so there's no w/w split.) + | 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] -> Maybe bdee -> StrictnessInfo bdee +mkStrictnessInfo :: [Demand] -> Bool -> StrictnessInfo -mkStrictnessInfo xs wrkr - | all is_lazy xs = NoStrictnessInfo -- Uninteresting - | otherwise = StrictnessInfo xs wrkr - where - is_lazy (WwLazy False) = True -- NB "Absent" args do *not* count! - is_lazy _ = False -- (as they imply a worker) +mkStrictnessInfo xs has_wrkr + | all isLazy xs = NoStrictnessInfo -- Uninteresting + | otherwise = StrictnessInfo xs has_wrkr noStrictnessInfo = NoStrictnessInfo mkBottomStrictnessInfo = BottomGuaranteed @@ -348,48 +336,23 @@ mkBottomStrictnessInfo = BottomGuaranteed bottomIsGuaranteed BottomGuaranteed = True bottomIsGuaranteed other = False -strictnessInfo (IdInfo _ _ _ strict _ _ _ _ _) = strict - -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 - -ppStrictnessInfo sty NoStrictnessInfo = ppNil -ppStrictnessInfo sty BottomGuaranteed = ppPStr SLIT("_S_ _!_") +ppStrictnessInfo NoStrictnessInfo = empty +ppStrictnessInfo BottomGuaranteed = ptext SLIT("__bot") -ppStrictnessInfo sty (StrictnessInfo wrapper_args wrkr_maybe) - = ppCat [ppPStr SLIT("_S_"), ppStr (showList wrapper_args ""), pp_wrkr] - where - pp_wrkr = case wrkr_maybe of - Nothing -> ppNil - Just wrkr -> ppr sty wrkr +ppStrictnessInfo (StrictnessInfo wrapper_args wrkr_maybe) + = hsep [ptext SLIT("__S"), pprDemands wrapper_args] \end{code} \begin{code} -workerExists :: StrictnessInfo bdee -> Bool -workerExists (StrictnessInfo _ (Just worker_id)) = True -workerExists other = False - -getWorkerId_maybe :: StrictnessInfo bdee -> Maybe bdee -getWorkerId_maybe (StrictnessInfo _ maybe_worker_id) = maybe_worker_id -getWorkerId_maybe other = Nothing +workerExists :: StrictnessInfo -> Bool +workerExists (StrictnessInfo _ worker_exists) = worker_exists +workerExists other = False \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@} %* * %************************************************************************ @@ -416,138 +379,34 @@ 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 = ppNil -ppUpdateInfo sty (SomeUpdateInfo []) = ppNil -ppUpdateInfo sty (SomeUpdateInfo spec) = ppBeside (ppPStr SLIT("_U_ ")) (ppBesides (map ppInt spec)) -\end{code} - -%************************************************************************ -%* * -\subsection[deforest-IdInfo]{Deforestation info about an @Id@} -%* * -%************************************************************************ - -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. - -\begin{code} -data DeforestInfo - = Don'tDeforest -- just a bool, might extend this - | DoDeforest -- later. - -- deriving (Eq, Ord) -\end{code} - -\begin{code} -deforestInfo (IdInfo _ _ _ _ _ _ deforest _ _) = deforest - -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 - -ppDeforestInfo sty Don'tDeforest = ppNil -ppDeforestInfo sty DoDeforest = ppPStr SLIT("_DEFOREST_") +ppUpdateInfo NoUpdateInfo = empty +ppUpdateInfo (SomeUpdateInfo []) = empty +ppUpdateInfo (SomeUpdateInfo spec) = (<>) (ptext SLIT("__U ")) (hcat (map int spec)) \end{code} %************************************************************************ %* * -\subsection[argUsage-IdInfo]{Argument Usage info about an @Id@} +\subsection[CAF-IdInfo]{CAF-related information} %* * %************************************************************************ -\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} - -\begin{code} -mkArgUsageInfo [] = NoArgUsageInfo -mkArgUsageInfo au = SomeArgUsageInfo au - -getArgUsage :: ArgUsageInfo -> ArgUsageType -getArgUsage NoArgUsageInfo = [] -getArgUsage (SomeArgUsageInfo u) = u -\end{code} - -\begin{code} -argUsageInfo (IdInfo _ _ _ _ _ _ _ au _) = au - -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 - -ppArgUsageInfo sty NoArgUsageInfo = ppNil -ppArgUsageInfo sty (SomeArgUsageInfo aut) = ppBeside (ppPStr SLIT("_L_ ")) (ppArgUsageType aut) - -ppArgUsage (ArgUsage n) = ppInt n -ppArgUsage (UnknownArgUsage) = ppChar '-' - -ppArgUsageType aut = ppBesides - [ ppChar '"' , - ppIntersperse ppComma (map ppArgUsage aut), - ppChar '"' ] -\end{code} - -%************************************************************************ -%* * -\subsection[FBType-IdInfo]{Type of an expression through Foldr/build's eyes} -%* * -%************************************************************************ +This information is used to build Static Reference Tables (see +simplStg/ComputeSRT.lhs). \begin{code} -data FBTypeInfo - = NoFBTypeInfo - | SomeFBTypeInfo FBType +data CafInfo + = MayHaveCafRefs -- either: + -- (1) A function or static constructor + -- that refers to one or more CAFs, + -- (2) A real live CAF -data FBType = FBType [FBConsum] FBProd deriving (Eq) + | NoCafRefs -- A function or static constructor + -- that refers to no CAFs. -data FBConsum = FBGoodConsum | FBBadConsum deriving(Eq) -data FBProd = FBGoodProd | FBBadProd deriving(Eq) -\end{code} +-- LATER: not sure how easy this is... +-- | OneCafRef Id -\begin{code} -mkFBTypeInfo = SomeFBTypeInfo -getFBType :: FBTypeInfo -> Maybe FBType -getFBType NoFBTypeInfo = Nothing -getFBType (SomeFBTypeInfo u) = Just u -\end{code} - -\begin{code} -fbTypeInfo (IdInfo _ _ _ _ _ _ _ _ fb) = fb - -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 - -ppFBTypeInfo sty NoFBTypeInfo = ppNil -ppFBTypeInfo sty (SomeFBTypeInfo (FBType cons prod)) - = ppBeside (ppPStr SLIT("_F_ ")) (ppFBType cons prod) - -ppFBType cons prod = ppBesides - ([ ppChar '"' ] ++ map ppCons cons ++ [ ppChar '-', ppProd prod, ppChar '"' ]) - where - ppCons FBGoodConsum = ppChar 'G' - ppCons FBBadConsum = ppChar 'B' - ppProd FBGoodProd = ppChar 'G' - ppProd FBBadProd = ppChar 'B' +ppCafInfo NoCafRefs = ptext SLIT("__C") +ppCafInfo MayHaveCafRefs = empty \end{code}