%
-% (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
+ vanillaIdInfo, mkIdInfo,
+ -- Flavour
+ IdFlavour(..), flavourInfo,
+ setNoDiscardInfo, zapSpecPragInfo, copyIdInfo,
+ ppFlavourInfo,
+
+ -- Arity
ArityInfo(..),
exactArity, atLeastArity, unknownArity,
- arityInfo, addArityInfo, ppArityInfo,
-
- DemandInfo,
- noDemandInfo, mkDemandInfo, demandInfo, ppDemandInfo, addDemandInfo, willBeDemanded,
+ arityInfo, setArityInfo, ppArityInfo, arityLowerBound,
+ -- Strictness
StrictnessInfo(..), -- Non-abstract
- Demand(..), NewOrData, -- Non-abstract
+ mkStrictnessInfo,
+ noStrictnessInfo, strictnessInfo,
+ ppStrictnessInfo, setStrictnessInfo,
+ isBottomingStrictness, appIsBottom,
- getWorkerId_maybe,
- workerExists,
- mkStrictnessInfo, mkBottomStrictnessInfo, noStrictnessInfo, bottomIsGuaranteed,
- strictnessInfo, ppStrictnessInfo, addStrictnessInfo,
+ -- Worker
+ WorkerInfo, workerExists,
+ workerInfo, setWorkerInfo,
- unfoldInfo, addUnfoldInfo,
+ -- Unfolding
+ unfoldingInfo, setUnfoldingInfo,
- specInfo, addSpecInfo,
+ -- DemandInfo
+ demandInfo, setDemandInfo,
- UpdateInfo, SYN_IE(UpdateSpec),
- mkUpdateInfo, updateInfo, updateInfoMaybe, ppUpdateInfo, addUpdateInfo,
+ -- Inline prags
+ InlinePragInfo(..), OccInfo(..),
+ inlinePragInfo, setInlinePragInfo, notInsideLambda,
- DeforestInfo(..),
- deforestInfo, ppDeforestInfo, addDeforestInfo,
+ -- Specialisation
+ specInfo, setSpecInfo,
- ArgUsageInfo, ArgUsage(..), SYN_IE(ArgUsageType),
- mkArgUsageInfo, argUsageInfo, addArgUsageInfo, getArgUsage,
+ -- Update
+ UpdateInfo, UpdateSpec,
+ mkUpdateInfo, updateInfo, updateInfoMaybe, ppUpdateInfo, setUpdateInfo,
- FBTypeInfo, FBType(..), FBConsum(..), FBProd(..),
- fbTypeInfo, ppFBTypeInfo, addFBTypeInfo, mkFBTypeInfo, getFBType
- ) where
+ -- CAF info
+ CafInfo(..), cafInfo, setCafInfo, ppCafInfo,
-IMP_Ubiq()
-IMPORT_1_3(Char(toLower))
+ -- Constructed Product Result Info
+ CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo,
-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".
+ -- Zapping
+ zapLamIdInfo, zapFragileIdInfo,
-import Type ( eqSimpleTy, splitFunTyExpandingDicts )
-import BasicTypes ( NewOrData )
-import CmdLineOpts ( opt_OmitInterfacePragmas )
+ -- Lambda-bound variable info
+ LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo
+ ) where
-import Demand
-import Maybes ( firstJust )
-import Outputable ( ifaceStyle, PprStyle(..), Outputable(..){-instances-} )
-import Pretty
-import PprType ()
-import Unique ( pprUnique )
-import Util ( mapAccumL, panic, assertPanic, pprPanic )
+#include "HsVersions.h"
-#ifdef REALLY_HASKELL_1_3
-ord = fromEnum :: Char -> Int
-#endif
-applySubstToTy = panic "IdInfo.applySubstToTy"
-showTypeCategory = panic "IdInfo.showTypeCategory"
+import {-# SOURCE #-} CoreUnfold ( Unfolding, noUnfolding, hasUnfolding )
+import {-# SOURCE #-} CoreSyn ( CoreExpr, CoreRules, emptyCoreRules, isEmptyCoreRules )
+import {-# SOURCE #-} Const ( Con )
+
+import Var ( Id )
+import FieldLabel ( FieldLabel )
+import Demand ( Demand, isStrict, isLazy, wwLazy, pprDemands )
+import Type ( UsageAnn )
+import Outputable
+import Maybe ( isJust )
+
+infixl 1 `setUpdateInfo`,
+ `setDemandInfo`,
+ `setStrictnessInfo`,
+ `setSpecInfo`,
+ `setArityInfo`,
+ `setInlinePragInfo`,
+ `setUnfoldingInfo`,
+ `setCprInfo`,
+ `setWorkerInfo`,
+ `setCafInfo`
+ -- 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 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
+ = 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 pragmas
+ }
+\end{code}
- ArgUsageInfo -- how this Id uses its arguments
+Setters
- FBTypeInfo -- the Foldr/Build W/W property of this function.
+\begin{code}
+setUpdateInfo info ud = info { updateInfo = ud }
+setDemandInfo info dd = info { demandInfo = dd }
+setStrictnessInfo info st = info { strictnessInfo = st }
+setWorkerInfo info wk = info { workerInfo = wk }
+setSpecInfo info sp = info { specInfo = sp }
+setArityInfo info ar = info { arityInfo = ar }
+setInlinePragInfo info pr = info { inlinePragInfo = pr }
+setUnfoldingInfo info uf = info { unfoldingInfo = uf }
+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
+
+copyIdInfo :: IdInfo -- From
+ -> IdInfo -- To
+ -> IdInfo -- To updated with stuff from From; except flavour unchanged
+-- 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.
+
+copyIdInfo from to = from { flavourInfo = flavourInfo to,
+ specInfo = specInfo to
+ }
+ -- It's important to propagate the inline pragmas from bndr
+ -- to exportd_id. Ditto strictness etc. This "bites" when we use an INLNE pragma:
+ -- {-# INLINE f #-}
+ -- f x = (x,x)
+ --
+ -- This becomes (where the "*" means INLINE prag)
+ --
+ -- M.f = /\a -> let mf* = \x -> (x,x) in mf
+ --
+ -- Now the mf floats out and we end up with the trivial binding
+ --
+ -- mf* = /\a -> \x -> (x,x)
+ -- M.f = mf
+ --
+ -- Now, when we short out the M.f = mf binding we must preserve the inline
+ -- pragma on the mf binding.
+ --
+ -- On the other hand, transformation rules may be attached to the
+ -- 'to' Id, and we want to preserve them.
\end{code}
+
\begin{code}
-noIdInfo = IdInfo UnknownArity UnknownDemand nullSpecEnv NoStrictnessInfo noUnfolding
- NoUpdateInfo Don'tDeforest NoArgUsageInfo NoFBTypeInfo
+vanillaIdInfo :: IdInfo
+vanillaIdInfo = mkIdInfo VanillaId
+
+mkIdInfo :: IdFlavour -> IdInfo
+mkIdInfo flv = IdInfo {
+ flavourInfo = flv,
+ arityInfo = UnknownArity,
+ demandInfo = wwLazy,
+ specInfo = emptyCoreRules,
+ workerInfo = Nothing,
+ strictnessInfo = NoStrictnessInfo,
+ unfoldingInfo = noUnfolding,
+ updateInfo = NoUpdateInfo,
+ cafInfo = MayHaveCafRefs,
+ cprInfo = NoCPRInfo,
+ lbvarInfo = NoLBVarInfo,
+ inlinePragInfo = NoInlinePragInfo
+ }
\end{code}
-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)
--}
-\end{code}
+%************************************************************************
+%* *
+\subsection{Flavour}
+%* *
+%************************************************************************
-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) }
--}
+data IdFlavour
+ = VanillaId -- Most Ids are like this
+ | ConstantId Con -- The Id for a constant (data constructor or primop)
+ | 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 (ConstantId _) = ptext SLIT("[Constr]")
+ppFlavourInfo (RecordSelId _) = ptext SLIT("[RecSel]")
+ppFlavourInfo SpecPragmaId = ptext SLIT("[SpecPrag]")
+ppFlavourInfo NoDiscardId = ptext SLIT("[NoDiscard]")
\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
- ]
-\end{code}
+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.
+
%************************************************************************
%* *
%* *
%************************************************************************
+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 (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]
+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).
+ | IMustNotBeINLINEd -- User NOINLINE pragma
-\begin{code}
-data DemandInfo
- = UnknownDemand
- | DemandedAsPer Demand
-\end{code}
+ | IAmALoopBreaker -- Used by the occurrence analyser to mark loop-breakers
+ -- in a group of recursive definitions
-\begin{code}
-noDemandInfo = UnknownDemand
+ | ICanSafelyBeINLINEd -- Used by the occurrence analyser to mark things
+ -- that manifesly occur once, not inside SCCs,
+ -- not in constructor arguments
-mkDemandInfo :: Demand -> DemandInfo
-mkDemandInfo demand = DemandedAsPer demand
+ OccInfo -- Says whether the occurrence is inside a lambda
+ -- If so, must only substitute WHNFs
-willBeDemanded :: DemandInfo -> Bool
-willBeDemanded (DemandedAsPer demand) = isStrict demand
-willBeDemanded _ = False
-\end{code}
+ Bool -- False <=> occurs in more than one case branch
+ -- If so, there's a code-duplication issue
-\begin{code}
-demandInfo (IdInfo _ demand _ _ _ _ _ _ _) = demand
+ | IAmDead -- Marks unused variables. Sometimes useful for
+ -- lambda and case-bound variables.
+
+ | IMustBeINLINEd -- Absolutely must inline; used for PrimOps and
+ -- constructors only.
-addDemandInfo (IdInfo a _ c d e f g h i) demand = IdInfo a demand c d e f g h i
+instance Outputable InlinePragInfo where
+ ppr NoInlinePragInfo = empty
+ ppr IMustBeINLINEd = ptext SLIT("__UU")
+ 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")
-ppDemandInfo PprInterface _ = empty
-ppDemandInfo sty UnknownDemand = text "{-# L #-}"
-ppDemandInfo sty (DemandedAsPer info) = hsep [text "{-#", text (showList [info] ""), text "#-}"]
+instance Show InlinePragInfo where
+ showsPrec p prag = showsPrecSDoc p (ppr prag)
\end{code}
-%************************************************************************
-%* *
-\subsection[specialisation-IdInfo]{Specialisation info about an @Id@}
-%* *
-%************************************************************************
+\begin{code}
+data OccInfo
+ = NotInsideLam
-See SpecEnv.lhs
+ | 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.
-\begin{code}
-specInfo (IdInfo _ _ spec _ _ _ _ _ _) = spec
+instance Outputable OccInfo where
+ ppr NotInsideLam = empty
+ ppr InsideLam = text "l"
-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
+
+notInsideLambda :: OccInfo -> Bool
+notInsideLambda NotInsideLam = True
+notInsideLambda InsideLam = False
\end{code}
%************************************************************************
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.
+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 bdee
+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] -- The main stuff; see below.
- (Maybe (bdee,[bdee])) -- 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.
- --
- -- This field might be Nothing even for a strict fn because the strictness info
- -- might say just "SSS" or something; so there's no w/w split.
+ | 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
\end{code}
\begin{code}
-mkStrictnessInfo :: [Demand] -> Maybe (bdee,[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, is_bot)
+ | all isLazy xs && not is_bot = NoStrictnessInfo -- Uninteresting
+ | otherwise = StrictnessInfo xs is_bot
noStrictnessInfo = NoStrictnessInfo
-mkBottomStrictnessInfo = BottomGuaranteed
-bottomIsGuaranteed BottomGuaranteed = True
-bottomIsGuaranteed other = False
+isBottomingStrictness (StrictnessInfo _ bot) = bot
+isBottomingStrictness NoStrictnessInfo = False
-strictnessInfo (IdInfo _ _ _ strict _ _ _ _ _) = strict
+-- appIsBottom returns true if an application to n args would diverge
+appIsBottom (StrictnessInfo ds bot) n = bot && (n >= length ds)
+appIsBottom NoStrictnessInfo n = False
-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 NoStrictnessInfo = empty
+ppStrictnessInfo (StrictnessInfo wrapper_args bot)
+ = hsep [ptext SLIT("__S"), pprDemands wrapper_args bot]
+\end{code}
-ppStrictnessInfo sty NoStrictnessInfo = empty
-ppStrictnessInfo sty BottomGuaranteed = ptext SLIT("_bot_")
+%************************************************************************
+%* *
+\subsection[worker-IdInfo]{Worker info about an @Id@}
+%* *
+%************************************************************************
-ppStrictnessInfo sty (StrictnessInfo wrapper_args wrkr_maybe)
- = hsep [ptext SLIT("_S_"), text (showList wrapper_args ""), pp_wrkr]
- where
- pp_wrkr = case wrkr_maybe of
- Nothing -> empty
- Just (wrkr,cons) | ifaceStyle sty &&
- not (null cons) -> pprId sty wrkr <+> braces (hsep (map (pprId sty) cons))
- | otherwise -> pprId sty wrkr
-\end{code}
+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.
+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}
-workerExists :: StrictnessInfo bdee -> Bool
-workerExists (StrictnessInfo _ (Just worker_id)) = True
-workerExists other = False
-getWorkerId_maybe :: StrictnessInfo bdee -> Maybe bdee
-getWorkerId_maybe (StrictnessInfo _ (Just (wrkr,_))) = Just wrkr
-getWorkerId_maybe other = Nothing
-\end{code}
+type WorkerInfo = Maybe Id
+{- UNUSED:
+mkWorkerInfo :: Id -> WorkerInfo
+mkWorkerInfo wk_id = Just wk_id
-%************************************************************************
-%* *
-\subsection[unfolding-IdInfo]{Unfolding info about an @Id@}
-%* *
-%************************************************************************
+ppWorkerInfo Nothing = empty
+ppWorkerInfo (Just wk_id) = ppr wk_id
+-}
-\begin{code}
-unfoldInfo (IdInfo _ _ _ _ unfolding _ _ _ _) = unfolding
+noWorkerInfo = Nothing
-addUnfoldInfo (IdInfo a b d e _ f g h i) uf = IdInfo a b d e uf f g h i
+workerExists :: Maybe Id -> Bool
+workerExists = isJust
\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 = 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("__U ")) (hcat (map int spec))
\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_")
+
+ppCafInfo NoCafRefs = ptext SLIT("__C")
+ppCafInfo MayHaveCafRefs = empty
\end{code}
+
%************************************************************************
%* *
-\subsection[argUsage-IdInfo]{Argument Usage info about an @Id@}
+\subsection[CAF-IdInfo]{CAF-related information}
%* *
%************************************************************************
+zapFragileIdInfo 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}
-data ArgUsageInfo
- = NoArgUsageInfo
- | SomeArgUsageInfo ArgUsageType
- -- ??? deriving (Eq, Ord)
-
-data ArgUsage = ArgUsage Int -- number of arguments (is linear!)
- | UnknownArgUsage
-type ArgUsageType = [ArgUsage] -- c_1 -> ... -> BLOB
+zapFragileIdInfo :: IdInfo -> Maybe IdInfo
+zapFragileIdInfo info@(IdInfo {inlinePragInfo = inline_prag,
+ specInfo = rules,
+ unfoldingInfo = unfolding})
+ | not is_fragile_inline_prag
+ -- 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
+
+ && isEmptyCoreRules rules
+ -- Specialisations would need substituting. They get pinned
+ -- back on separately.
+
+ && 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
+
+ | otherwise
+ = Just (info {inlinePragInfo = safe_inline_prag,
+ specInfo = emptyCoreRules,
+ unfoldingInfo = noUnfolding})
+
+ where
+ is_fragile_inline_prag = case inline_prag of
+ ICanSafelyBeINLINEd _ _ -> True
+
+-- We used to say the dead-ness was fragile, but I don't
+-- see why it is. Furthermore, deadness is a pain to lose;
+-- see Simplify.mkDupableCont (Select ...)
+-- IAmDead -> True
+
+ other -> False
+
+ -- Be careful not to destroy real 'pragma' info
+ safe_inline_prag | is_fragile_inline_prag = NoInlinePragInfo
+ | otherwise = inline_prag
\end{code}
+
+@zapLamIdInfo@ is used for lambda binders that turn out to to be
+part of an unsaturated lambda
+
\begin{code}
-mkArgUsageInfo [] = NoArgUsageInfo
-mkArgUsageInfo au = SomeArgUsageInfo au
+zapLamIdInfo :: IdInfo -> Maybe IdInfo
+zapLamIdInfo info@(IdInfo {inlinePragInfo = inline_prag, demandInfo = demand})
+ | is_safe_inline_prag && not (isStrict demand)
+ = Nothing
+ | otherwise
+ = Just (info {inlinePragInfo = safe_inline_prag,
+ demandInfo = wwLazy})
+ where
+ -- The "unsafe" prags are the ones that say I'm not in a lambda
+ -- because that might not be true for an unsaturated lambda
+ is_safe_inline_prag = case inline_prag of
+ ICanSafelyBeINLINEd NotInsideLam nalts -> False
+ other -> True
+
+ safe_inline_prag = case inline_prag of
+ ICanSafelyBeINLINEd _ nalts
+ -> ICanSafelyBeINLINEd InsideLam nalts
+ other -> inline_prag
+\end{code}
+
-getArgUsage :: ArgUsageInfo -> ArgUsageType
-getArgUsage NoArgUsageInfo = []
-getArgUsage (SomeArgUsageInfo u) = u
+%************************************************************************
+%* *
+\subsection[cpr-IdInfo]{Constructed Product Result info about an @Id@}
+%* *
+%************************************************************************
+
+If the @Id@ is a function then it may have CPR info. A CPR analysis
+phase detects whether:
+
+\begin{enumerate}
+\item
+The function's return value has a product type, i.e. an algebraic type
+with a single constructor. Examples of such types are tuples and boxed
+primitive values.
+\item
+The function always 'constructs' the value that it is returning. It
+must do this on every path through, and it's OK if it calls another
+function which constructs the result.
+\end{enumerate}
+
+If this is the case then we store a template which tells us the
+function has the CPR property and which components of the result are
+also CPRs.
+
+\begin{code}
+data CprInfo
+ = NoCPRInfo
+
+ | 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}
\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
+noCprInfo = NoCPRInfo
-ppArgUsageInfo sty NoArgUsageInfo = empty
-ppArgUsageInfo sty (SomeArgUsageInfo aut) = (<>) (ptext SLIT("_L_ ")) (ppArgUsageType aut)
+ppCprInfo NoCPRInfo = empty
+ppCprInfo c@(CPRInfo _)
+ = hsep [ptext SLIT("__M"), ppCprInfo' c]
+ where
+ ppCprInfo' NoCPRInfo = char '-'
+ ppCprInfo' (CPRInfo args) = parens (hcat (map ppCprInfo' args))
-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@}
%* *
%************************************************************************
-\begin{code}
-data FBTypeInfo
- = NoFBTypeInfo
- | SomeFBTypeInfo FBType
-
-data FBType = FBType [FBConsum] FBProd deriving (Eq)
+If the @Id@ is a lambda-bound variable then it may have lambda-bound
+var info. The usage analysis (UsageSP) detects whether the lambda
+binding this var is a ``one-shot'' lambda; that is, whether it is
+applied at most once.
-data FBConsum = FBGoodConsum | FBBadConsum deriving(Eq)
-data FBProd = FBGoodProd | FBBadProd deriving(Eq)
-\end{code}
+This information may be useful in optimisation, as computations may
+safely be floated inside such a lambda without risk of duplicating
+work.
\begin{code}
-mkFBTypeInfo = SomeFBTypeInfo
-
-getFBType :: FBTypeInfo -> Maybe FBType
-getFBType NoFBTypeInfo = Nothing
-getFBType (SomeFBTypeInfo u) = Just u
+data LBVarInfo
+ = NoLBVarInfo
+
+ | 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.
\end{code}
\begin{code}
-fbTypeInfo (IdInfo _ _ _ _ _ _ _ _ fb) = fb
+noLBVarInfo = NoLBVarInfo
-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
+-- 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")
-ppFBTypeInfo sty NoFBTypeInfo = empty
-ppFBTypeInfo sty (SomeFBTypeInfo (FBType cons prod))
- = (<>) (ptext SLIT("_F_ ")) (ppFBType cons prod)
+instance Outputable LBVarInfo where
+ ppr = pprLBVarInfo
-ppFBType cons prod = hcat
- ([ char '"' ] ++ map ppCons cons ++ [ char '-', ppProd prod, char '"' ])
- where
- ppCons FBGoodConsum = char 'G'
- ppCons FBBadConsum = char 'B'
- ppProd FBGoodProd = char 'G'
- ppProd FBBadProd = char 'B'
+instance Show LBVarInfo where
+ showsPrec p c = showsPrecSDoc p (ppr c)
\end{code}
projects / ghc-hetmet.git / blobdiff