X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FIdInfo.lhs;h=f2084c8265835f0080d2c089c06e2161a04e9bbe;hb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;hp=b9e81f9d6c2c34d56379bc55be9f3e4bcbe44472;hpb=a6c7e7dc8d0c5626ea29c71c3fc957d33064697b;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs index b9e81f9..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,74 +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(..), NewOrData, -- Non-abstract + workerExists, mkStrictnessInfo, mkBottomStrictnessInfo, + noStrictnessInfo, bottomIsGuaranteed, strictnessInfo, + ppStrictnessInfo, setStrictnessInfo, - 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, - 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 + -- CAF info + CafInfo(..), cafInfo, setCafInfo, ppCafInfo, ) 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 {-# SOURCE #-} CoreUnfold ( Unfolding, noUnfolding ) +import {-# SOURCE #-} CoreSyn ( CoreExpr ) + +import SpecEnv ( SpecEnv, emptySpecEnv ) +import Demand ( Demand, isLazy, wwLazy, pprDemands ) +import Outputable \end{code} An @IdInfo@ gives {\em optional} information about an @Id@. If @@ -91,73 +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 -- Strictness properties - - Unfolding -- Its unfolding; for locally-defined - -- things, this can *only* be NoUnfolding - - UpdateInfo -- Which args should be updated - - 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 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 arg_usage fb_ww) - | isNullSpecEnv spec - = idinfo - | otherwise - = panic "IdInfo:apply_to_IdInfo" +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 arg_usage fb_ww) - = panic "IdInfo:applySubstToIdInfo" +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 - -> Doc - -ppIdInfo sty specs_please - (IdInfo arity demand specenv strictness unfold update arg_usage fbtype) +ppIdInfo :: IdInfo -> SDoc +ppIdInfo (IdInfo {arityInfo, + demandInfo, + specInfo, + strictnessInfo, + unfoldingInfo, + updateInfo, + cafInfo, + inlinePragInfo}) = hsep [ - -- order is important!: - ppArityInfo sty arity, - ppUpdateInfo sty update, - - 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 + ppArityInfo arityInfo, + ppUpdateInfo updateInfo, + ppStrictnessInfo strictnessInfo, + ppr demandInfo, + ppCafInfo cafInfo + -- Inline pragma printed out with all binders; see PprCore.pprIdBndr ] \end{code} @@ -167,65 +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 (IdInfo _ a b c d e f g) arity = IdInfo arity a b c d e f g -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 + + | IAmASpecPragmaId -- Used for spec-pragma Ids; don't discard or inline -This information is only used within a module, it is not exported -(obviously). + | IWantToBeINLINEd -- User INLINE pragma + | 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 + + OccInfo -- Says whether the occurrence is inside a lambda + -- If so, must only substitute WHNFs -mkDemandInfo :: Demand -> DemandInfo -mkDemandInfo demand = DemandedAsPer demand + Bool -- False <=> occurs in more than one case branch + -- If so, there's a code-duplication issue -willBeDemanded :: DemandInfo -> Bool -willBeDemanded (DemandedAsPer demand) = isStrict demand -willBeDemanded _ = False + | IAmDead -- Marks unused variables. Sometimes useful for + -- lambda and case-bound variables. + + | IMustBeINLINEd -- Absolutely must inline; used for PrimOps and + -- constructors only. + +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 -addDemandInfo (IdInfo a _ c d e f g h) demand = IdInfo a demand c d e f g h + | 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. -ppDemandInfo PprInterface _ = empty -ppDemandInfo sty UnknownDemand = text "{-# L #-}" -ppDemandInfo sty (DemandedAsPer info) = hsep [text "{-#", text (showList [info] ""), text "#-}"] +instance Outputable OccInfo where + ppr StrictOcc = text "s" + ppr LazyOcc = empty + ppr InsideLam = text "l" + + +notInsideLambda :: OccInfo -> Bool +notInsideLambda StrictOcc = True +notInsideLambda LazyOcc = True +notInsideLambda InsideLam = False \end{code} %************************************************************************ @@ -234,15 +249,39 @@ ppDemandInfo sty (DemandedAsPer info) = hsep [text "{-#", text (showList [info] %* * %************************************************************************ -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) spec = IdInfo a b spec d e f g h +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@} @@ -288,11 +327,8 @@ data StrictnessInfo mkStrictnessInfo :: [Demand] -> Bool -> StrictnessInfo mkStrictnessInfo xs has_wrkr - | all is_lazy xs = NoStrictnessInfo -- Uninteresting + | all isLazy 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) noStrictnessInfo = NoStrictnessInfo mkBottomStrictnessInfo = BottomGuaranteed @@ -300,16 +336,11 @@ 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) strict = IdInfo a b d strict e f g h - -ppStrictnessInfo sty NoStrictnessInfo = empty -ppStrictnessInfo sty BottomGuaranteed = ptext SLIT("_bot_") +ppStrictnessInfo NoStrictnessInfo = empty +ppStrictnessInfo BottomGuaranteed = ptext SLIT("__bot") -ppStrictnessInfo sty (StrictnessInfo wrapper_args wrkr_maybe) - = hsep [ptext SLIT("_S_"), text (showList wrapper_args "")] +ppStrictnessInfo (StrictnessInfo wrapper_args wrkr_maybe) + = hsep [ptext SLIT("__S"), pprDemands wrapper_args] \end{code} @@ -322,18 +353,6 @@ workerExists other = False %************************************************************************ %* * -\subsection[unfolding-IdInfo]{Unfolding info about an @Id@} -%* * -%************************************************************************ - -\begin{code} -unfoldInfo (IdInfo _ _ _ _ unfolding _ _ _) = unfolding - -addUnfoldInfo (IdInfo a b d e _ f g h) uf = IdInfo a b d e uf f g h -\end{code} - -%************************************************************************ -%* * \subsection[update-IdInfo]{Update-analysis info about an @Id@} %* * %************************************************************************ @@ -360,111 +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) upd_info = IdInfo a b d e f upd_info g h - -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[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) au_info = IdInfo a b d e f g au_info h - -ppArgUsageInfo sty NoArgUsageInfo = empty -ppArgUsageInfo sty (SomeArgUsageInfo aut) = (<>) (ptext SLIT("_L_ ")) (ppArgUsageType aut) - -ppArgUsage (ArgUsage n) = int n -ppArgUsage (UnknownArgUsage) = char '-' - -ppArgUsageType aut = hcat - [ char '"' , - hcat (punctuate comma (map ppArgUsage aut)), - char '"' ] -\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 _) fb_info = IdInfo a b d e f g h fb_info - -ppFBTypeInfo sty NoFBTypeInfo = empty -ppFBTypeInfo sty (SomeFBTypeInfo (FBType cons prod)) - = (<>) (ptext SLIT("_F_ ")) (ppFBType cons prod) - -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' +ppCafInfo NoCafRefs = ptext SLIT("__C") +ppCafInfo MayHaveCafRefs = empty \end{code}