%
-% (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@}
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
\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}
%* *
%************************************************************************
+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}
%************************************************************************
%* *
%************************************************************************
-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@}
it exists); i.e. its calling convention.
\begin{code}
-data StrictnessInfo bdee
+data StrictnessInfo
= NoStrictnessInfo
| BottomGuaranteed -- This Id guarantees never to return;
-- 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
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@}
%* *
%************************************************************************
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}
projects / ghc-hetmet.git / blobdiff