X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FIdInfo.lhs;h=a251c7e5aca25e22b9baacb4a83259cfa2740835;hb=ce9687a5f450014c5596b32de8e8a7b99b6389e8;hp=7541f7456ca965b8c2e603ce1e762b1a4422038a;hpb=d8af6b8ce9d241a8f8d6878e2400aa8577f552bc;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs index 7541f74..a251c7e 100644 --- a/ghc/compiler/basicTypes/IdInfo.lhs +++ b/ghc/compiler/basicTypes/IdInfo.lhs @@ -11,7 +11,7 @@ module IdInfo ( GlobalIdDetails(..), notGlobalId, -- Not abstract IdInfo, -- Abstract - vanillaIdInfo, noCafNoTyGenIdInfo, + vanillaIdInfo, noCafIdInfo, hasCafIdInfo, seqIdInfo, megaSeqIdInfo, -- Zapping @@ -25,19 +25,13 @@ module IdInfo ( -- New demand and strictness info newStrictnessInfo, setNewStrictnessInfo, - newDemandInfo, setNewDemandInfo, newDemand, oldDemand, + newDemandInfo, setNewDemandInfo, -- Strictness; imported from Demand StrictnessInfo(..), mkStrictnessInfo, noStrictnessInfo, ppStrictnessInfo,isBottomingStrictness, - strictnessInfo, setStrictnessInfo, setAllStrictnessInfo, - oldStrictnessFromNew, newStrictnessFromOld, cprInfoFromNewStrictness, - - -- Usage generalisation - TyGenInfo(..), - tyGenInfo, setTyGenInfo, - noTyGenInfo, isNoTyGenInfo, ppTyGenInfo, tyGenInfoString, + setAllStrictnessInfo, -- Worker WorkerInfo(..), workerExists, wrapperArity, workerId, @@ -46,8 +40,17 @@ module IdInfo ( -- Unfolding unfoldingInfo, setUnfoldingInfo, - -- DemandInfo +#ifdef OLD_STRICTNESS + -- Old DemandInfo and StrictnessInfo demandInfo, setDemandInfo, + strictnessInfo, setStrictnessInfo, + cprInfoFromNewStrictness, + oldStrictnessFromNew, newStrictnessFromOld, + oldDemand, newDemand, + + -- Constructed Product Result Info + CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo, +#endif -- Inline prags InlinePragInfo, @@ -69,9 +72,6 @@ module IdInfo ( -- CAF info CafInfo(..), ppCafInfo, setCafInfo, mayHaveCafRefs, - -- Constructed Product Result Info - CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo, - -- Lambda-bound variable info LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo, hasNoLBVarInfo ) where @@ -95,25 +95,19 @@ import DataCon ( DataCon ) import ForeignCall ( ForeignCall ) import FieldLabel ( FieldLabel ) import Type ( usOnce, usMany ) -import Demand hiding( Demand ) +import Demand hiding( Demand, seqDemand ) import qualified Demand -import NewDemand ( Demand(..), DmdResult(..), Demands(..), - lazyDmd, topDmd, dmdTypeDepth, isStrictDmd, isBotRes, - splitStrictSig, strictSigResInfo, - StrictSig, mkStrictSig, mkTopDmdType, evalDmd, lazyDmd - ) +import NewDemand import Outputable import Util ( seqList, listLengthCmp ) +import Maybe ( isJust ) import List ( replicate ) -infixl 1 `setDemandInfo`, - `setTyGenInfo`, - `setStrictnessInfo`, - `setSpecInfo`, +-- infixl so you can say (id `set` a `set` b) +infixl 1 `setSpecInfo`, `setArityInfo`, `setInlinePragInfo`, `setUnfoldingInfo`, - `setCprInfo`, `setWorkerInfo`, `setLBVarInfo`, `setOccInfo`, @@ -122,7 +116,11 @@ infixl 1 `setDemandInfo`, `setNewStrictnessInfo`, `setAllStrictnessInfo`, `setNewDemandInfo` - -- infixl so you can say (id `set` a `set` b) +#ifdef OLD_STRICTNESS + , `setCprInfo` + , `setDemandInfo` + , `setStrictnessInfo` +#endif \end{code} %************************************************************************ @@ -134,17 +132,28 @@ infixl 1 `setDemandInfo`, To be removed later \begin{code} -setAllStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo +-- setAllStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo -- Set old and new strictness info setAllStrictnessInfo info Nothing - = info { newStrictnessInfo = Nothing, - strictnessInfo = NoStrictnessInfo, - cprInfo = NoCPRInfo } + = info { newStrictnessInfo = Nothing +#ifdef OLD_STRICTNESS + , strictnessInfo = NoStrictnessInfo + , cprInfo = NoCPRInfo +#endif + } + setAllStrictnessInfo info (Just sig) - = info { newStrictnessInfo = Just sig, - strictnessInfo = oldStrictnessFromNew sig, - cprInfo = cprInfoFromNewStrictness sig } + = info { newStrictnessInfo = Just sig +#ifdef OLD_STRICTNESS + , strictnessInfo = oldStrictnessFromNew sig + , cprInfo = cprInfoFromNewStrictness sig +#endif + } + +seqNewStrictnessInfo Nothing = () +seqNewStrictnessInfo (Just ty) = seqStrictSig ty +#ifdef OLD_STRICTNESS oldStrictnessFromNew :: StrictSig -> Demand.StrictnessInfo oldStrictnessFromNew sig = mkStrictnessInfo (map oldDemand dmds, isBotRes res_info) where @@ -174,7 +183,7 @@ mk_strict_sig name arity dmd_ty mkStrictSig dmd_ty newRes True _ = BotRes -newRes False ReturnsCPR = RetCPR +newRes False ReturnsCPR = retCPR newRes False NoCPRInfo = TopRes newDemand :: Demand.Demand -> NewDemand.Demand @@ -196,6 +205,14 @@ oldDemand (Defer d) = WwLazy False oldDemand (Eval (Prod ds)) = WwUnpack True (map oldDemand ds) oldDemand (Eval (Poly _)) = WwStrict oldDemand (Call _) = WwStrict + +#endif /* OLD_STRICTNESS */ +\end{code} + + +\begin{code} +seqNewDemandInfo Nothing = () +seqNewDemandInfo (Just dmd) = seqDemand dmd \end{code} @@ -261,15 +278,16 @@ case. KSW 1999-04). \begin{code} data IdInfo = IdInfo { - arityInfo :: ArityInfo, -- Its arity - demandInfo :: Demand.Demand, -- Whether or not it is definitely demanded + arityInfo :: !ArityInfo, -- Its arity specInfo :: CoreRules, -- Specialisations of this function which exist - tyGenInfo :: TyGenInfo, -- Restrictions on usage-generalisation of this Id +#ifdef OLD_STRICTNESS + cprInfo :: CprInfo, -- Function always constructs a product result + demandInfo :: Demand.Demand, -- Whether or not it is definitely demanded strictnessInfo :: StrictnessInfo, -- Strictness properties +#endif workerInfo :: WorkerInfo, -- Pointer to Worker Function unfoldingInfo :: Unfolding, -- Its unfolding cgInfo :: CgInfo, -- Code generator info (arity, CAF info) - cprInfo :: CprInfo, -- Function always constructs a product result lbvarInfo :: LBVarInfo, -- Info about a lambda-bound variable inlinePragInfo :: InlinePragInfo, -- Inline pragma occInfo :: OccInfo, -- How it occurs @@ -278,7 +296,10 @@ data IdInfo -- know whether whether this is the first visit, -- so it can assign botSig. Other customers want -- topSig. So Nothing is good. - newDemandInfo :: Demand + + newDemandInfo :: Maybe Demand -- Similarly we want to know if there's no + -- known demand yet, for when we are looking for + -- CPR info } seqIdInfo :: IdInfo -> () @@ -286,21 +307,25 @@ seqIdInfo (IdInfo {}) = () megaSeqIdInfo :: IdInfo -> () megaSeqIdInfo info - = seqArity (arityInfo info) `seq` - seqDemand (demandInfo info) `seq` - seqRules (specInfo info) `seq` - seqTyGenInfo (tyGenInfo info) `seq` - seqStrictnessInfo (strictnessInfo info) `seq` + = seqRules (specInfo info) `seq` seqWorker (workerInfo info) `seq` --- seqUnfolding (unfoldingInfo info) `seq` -- Omitting this improves runtimes a little, presumably because -- some unfoldings are not calculated at all +-- seqUnfolding (unfoldingInfo info) `seq` + + seqNewDemandInfo (newDemandInfo info) `seq` + seqNewStrictnessInfo (newStrictnessInfo info) `seq` + +#ifdef OLD_STRICTNESS + Demand.seqDemand (demandInfo info) `seq` + seqStrictnessInfo (strictnessInfo info) `seq` + seqCpr (cprInfo info) `seq` +#endif -- CgInfo is involved in a loop, so we have to be careful not to seq it -- too early. -- seqCg (cgInfo info) `seq` - seqCpr (cprInfo info) `seq` seqLBVar (lbvarInfo info) `seq` seqOccInfo (occInfo info) \end{code} @@ -310,10 +335,11 @@ Setters \begin{code} setWorkerInfo info wk = wk `seq` info { workerInfo = wk } setSpecInfo info sp = sp `seq` info { specInfo = sp } -setTyGenInfo info tg = tg `seq` info { tyGenInfo = tg } setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr } setOccInfo info oc = oc `seq` info { occInfo = oc } +#ifdef OLD_STRICTNESS setStrictnessInfo info st = st `seq` info { strictnessInfo = st } +#endif -- Try to avoid spack leaks by seq'ing setUnfoldingInfo info uf @@ -327,21 +353,25 @@ setUnfoldingInfo info uf -- let x = (a,b) in h a b x -- and now x is not demanded (I'm assuming h is lazy) -- This really happens. The solution here is a bit ad hoc... - = info { unfoldingInfo = uf, newDemandInfo = Top } + = info { unfoldingInfo = uf, newDemandInfo = Nothing } | otherwise -- We do *not* seq on the unfolding info, For some reason, doing so -- actually increases residency significantly. = info { unfoldingInfo = uf } +#ifdef OLD_STRICTNESS setDemandInfo info dd = info { demandInfo = dd } +setCprInfo info cp = info { cprInfo = cp } +#endif + setArityInfo info ar = info { arityInfo = ar } setCgInfo info cg = info { cgInfo = cg } -setCprInfo info cp = info { cprInfo = cp } -setLBVarInfo info lb = info { lbvarInfo = lb } -setNewDemandInfo info dd = info { newDemandInfo = dd } -setNewStrictnessInfo info dd = info { newStrictnessInfo = dd } +setLBVarInfo info lb = {-lb `seq`-} info { lbvarInfo = lb } + +setNewDemandInfo info dd = dd `seq` info { newDemandInfo = dd } +setNewStrictnessInfo info dd = dd `seq` info { newStrictnessInfo = dd } \end{code} @@ -351,25 +381,26 @@ vanillaIdInfo = IdInfo { cgInfo = noCgInfo, arityInfo = unknownArity, +#ifdef OLD_STRICTNESS + cprInfo = NoCPRInfo, demandInfo = wwLazy, + strictnessInfo = NoStrictnessInfo, +#endif specInfo = emptyCoreRules, - tyGenInfo = noTyGenInfo, workerInfo = NoWorker, - strictnessInfo = NoStrictnessInfo, unfoldingInfo = noUnfolding, - cprInfo = NoCPRInfo, lbvarInfo = NoLBVarInfo, inlinePragInfo = AlwaysActive, occInfo = NoOccInfo, - newDemandInfo = topDmd, + newDemandInfo = Nothing, newStrictnessInfo = Nothing } -noCafNoTyGenIdInfo = vanillaIdInfo `setTyGenInfo` TyGenNever - `setCgInfo` CgInfo NoCafRefs +hasCafIdInfo = vanillaIdInfo `setCgInfo` CgInfo MayHaveCafRefs +noCafIdInfo = vanillaIdInfo `setCgInfo` CgInfo NoCafRefs -- Used for built-in type Ids in MkId. - -- Many built-in things have fixed types, so we shouldn't - -- run around generalising them + -- These must have a valid CgInfo set, so you can't + -- use vanillaIdInfo! \end{code} @@ -393,9 +424,6 @@ type ArityInfo = Arity -- The arity might increase later in the compilation process, if -- an extra lambda floats up to the binding site. -seqArity :: ArityInfo -> () -seqArity a = a `seq` () - unknownArity = 0 :: Arity ppArityInfo 0 = empty @@ -420,81 +448,6 @@ type InlinePragInfo = Activation %************************************************************************ -%* * -\subsection[TyGen-IdInfo]{Type generalisation info about an @Id@} -%* * -%************************************************************************ - -Certain passes (notably usage inference) may change the type of an -identifier, modifying all in-scope uses of that identifier -appropriately to maintain type safety. - -However, some identifiers must not have their types changed in this -way, because their types are conjured up in the front end of the -compiler rather than being read from the interface file. Default -methods, dictionary functions, record selectors, and others are in -this category. (see comment at TcClassDcl.tcClassSig). - -To indicate this property, such identifiers are marked TyGenNever. - -Furthermore, if the usage inference generates a usage-specialised -variant of a function, we must NOT re-infer a fully-generalised type -at the next inference. This finer property is indicated by a -TyGenUInfo on the identifier. - -\begin{code} -data TyGenInfo - = NoTyGenInfo -- no restriction on type generalisation - - | TyGenUInfo [Maybe Type] -- restrict generalisation of this Id to - -- preserve specified usage annotations - - | TyGenNever -- never generalise the type of this Id -\end{code} - -For TyGenUInfo, the list has one entry for each usage annotation on -the type of the Id, in left-to-right pre-order (annotations come -before the type they annotate). Nothing means no restriction; Just -usOnce or Just usMany forces that annotation to that value. Other -usage annotations are illegal. - -\begin{code} -seqTyGenInfo :: TyGenInfo -> () -seqTyGenInfo NoTyGenInfo = () -seqTyGenInfo (TyGenUInfo us) = seqList us () -seqTyGenInfo TyGenNever = () - -noTyGenInfo :: TyGenInfo -noTyGenInfo = NoTyGenInfo - -isNoTyGenInfo :: TyGenInfo -> Bool -isNoTyGenInfo NoTyGenInfo = True -isNoTyGenInfo _ = False - --- NB: There's probably no need to write this information out to the interface file. --- Why? Simply because imported identifiers never get their types re-inferred. --- But it's definitely nice to see in dumps, it for debugging purposes. - -ppTyGenInfo :: TyGenInfo -> SDoc -ppTyGenInfo NoTyGenInfo = empty -ppTyGenInfo (TyGenUInfo us) = ptext SLIT("__G") <+> text (tyGenInfoString us) -ppTyGenInfo TyGenNever = ptext SLIT("__G N") - -tyGenInfoString us = map go us - where go Nothing = 'x' -- for legibility, choose - go (Just u) | u `eqUsage` usOnce = '1' -- chars with identity - | u `eqUsage` usMany = 'M' -- Z-encoding. - go other = pprPanic "IdInfo.tyGenInfoString: unexpected annotation" (ppr other) - -instance Outputable TyGenInfo where - ppr = ppTyGenInfo - -instance Show TyGenInfo where - showsPrec p c = showsPrecSDoc p (ppr c) -\end{code} - - -%************************************************************************ %* * \subsection[worker-IdInfo]{Worker info about an @Id@} %* * @@ -502,7 +455,7 @@ instance Show TyGenInfo where 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. +information from strictness analysis. There might not be a worker, even for a strict function, because: (a) the function might be small enough to inline, so no need @@ -534,7 +487,7 @@ data WorkerInfo = NoWorker -- w/w split. See comments in MkIface.ifaceId, with the 'Worker' code. seqWorker :: WorkerInfo -> () -seqWorker (HasWorker id _) = id `seq` () +seqWorker (HasWorker id a) = id `seq` a `seq` () seqWorker NoWorker = () ppWorkerInfo NoWorker = empty @@ -564,7 +517,7 @@ but only as a thunk --- the information is only actually produced further downstream, by the code generator. \begin{code} -#ifndef DEBUG +#ifndef OLD_STRICTNESS newtype CgInfo = CgInfo CafInfo -- We are back to only having CafRefs in CgInfo noCgInfo = panic "NoCgInfo!" #else @@ -643,6 +596,7 @@ function has the CPR property and which components of the result are also CPRs. \begin{code} +#ifdef OLD_STRICTNESS data CprInfo = NoCPRInfo | ReturnsCPR -- Yes, this function returns a constructed product @@ -653,9 +607,7 @@ data CprInfo -- We used to keep nested info about sub-components, but -- we never used it so I threw it away -\end{code} -\begin{code} seqCpr :: CprInfo -> () seqCpr ReturnsCPR = () seqCpr NoCPRInfo = () @@ -670,6 +622,7 @@ instance Outputable CprInfo where instance Show CprInfo where showsPrec p c = showsPrecSDoc p (ppr c) +#endif \end{code} @@ -713,10 +666,7 @@ noLBVarInfo = NoLBVarInfo -- property of the definition, but a property of the context. pprLBVarInfo NoLBVarInfo = empty pprLBVarInfo (LBVarInfo u) | u `eqUsage` usOnce - = getPprStyle $ \ sty -> - if ifaceStyle sty - then empty - else ptext SLIT("OneShot") + = ptext SLIT("OneShot") | otherwise = empty @@ -740,28 +690,29 @@ part of an unsaturated lambda \begin{code} zapLamInfo :: IdInfo -> Maybe IdInfo zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand}) - | is_safe_occ && not (isStrictDmd demand) + | is_safe_occ occ && is_safe_dmd demand = Nothing | otherwise - = Just (info {occInfo = safe_occ, - newDemandInfo = Top}) + = Just (info {occInfo = safe_occ, newDemandInfo = Nothing}) where -- The "unsafe" occ info is the ones that say I'm not in a lambda -- because that might not be true for an unsaturated lambda - is_safe_occ = case occ of - OneOcc in_lam once -> in_lam - other -> True + is_safe_occ (OneOcc in_lam once) = in_lam + is_safe_occ other = True safe_occ = case occ of OneOcc _ once -> OneOcc insideLam once other -> occ + + is_safe_dmd Nothing = True + is_safe_dmd (Just dmd) = not (isStrictDmd dmd) \end{code} \begin{code} zapDemandInfo :: IdInfo -> Maybe IdInfo -zapDemandInfo info@(IdInfo {newDemandInfo = demand}) - | not (isStrictDmd demand) = Nothing - | otherwise = Just (info {newDemandInfo = Top}) +zapDemandInfo info@(IdInfo {newDemandInfo = dmd}) + | isJust dmd = Just (info {newDemandInfo = Nothing}) + | otherwise = Nothing \end{code} @@ -823,8 +774,11 @@ shortableIdInfo info = isEmptyCoreRules (specInfo info) copyIdInfo :: IdInfo -- f_local -> IdInfo -- f (the exported one) -> IdInfo -- New info for f -copyIdInfo f_local f = f { strictnessInfo = strictnessInfo f_local, - workerInfo = workerInfo f_local, - cprInfo = cprInfo f_local +copyIdInfo f_local f = f { newStrictnessInfo = newStrictnessInfo f_local, +#ifdef OLD_STRICTNESS + strictnessInfo = strictnessInfo f_local, + cprInfo = cprInfo f_local, +#endif + workerInfo = workerInfo f_local } \end{code}