X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FIdInfo.lhs;h=9e1a3f0668d7df3ffde5a7fa59cf4fd501687d82;hb=9541ef3440f89f5f275509b1cc64fb9c498dcf73;hp=b13044564fd08cb86cedad8bfaec88933e209742;hpb=8fe4dbdd4d32e885c476842997ef91ae7fa865d8;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs index b130445..9e1a3f0 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, seqIdInfo, megaSeqIdInfo, -- Zapping @@ -20,38 +20,43 @@ module IdInfo ( -- Arity ArityInfo, - exactArity, unknownArity, hasArity, - arityInfo, setArityInfo, ppArityInfo, arityLowerBound, + unknownArity, + arityInfo, setArityInfo, ppArityInfo, -- New demand and strictness info - newStrictnessInfo, setNewStrictnessInfo, mkNewStrictnessInfo, - newDemandInfo, setNewDemandInfo, newDemand, oldDemand, + newStrictnessInfo, setNewStrictnessInfo, + newDemandInfo, setNewDemandInfo, pprNewStrictness, + setAllStrictnessInfo, +#ifdef OLD_STRICTNESS -- Strictness; imported from Demand StrictnessInfo(..), mkStrictnessInfo, noStrictnessInfo, ppStrictnessInfo,isBottomingStrictness, - strictnessInfo, setStrictnessInfo, - - -- Usage generalisation - TyGenInfo(..), - tyGenInfo, setTyGenInfo, - noTyGenInfo, isNoTyGenInfo, ppTyGenInfo, tyGenInfoString, +#endif -- Worker WorkerInfo(..), workerExists, wrapperArity, workerId, workerInfo, setWorkerInfo, ppWorkerInfo, -- Unfolding - unfoldingInfo, setUnfoldingInfo, + unfoldingInfo, setUnfoldingInfo, setUnfoldingInfoLazily, - -- 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(..), - inlinePragInfo, setInlinePragInfo, pprInlinePragInfo, - isNeverInlinePrag, neverInlinePrag, + InlinePragInfo, + inlinePragInfo, setInlinePragInfo, -- Occurrence info OccInfo(..), isFragileOcc, isDeadOcc, isLoopBreaker, @@ -61,17 +66,8 @@ module IdInfo ( -- Specialisation specInfo, setSpecInfo, - -- CG info - CgInfo(..), cgInfo, setCgInfo, cgMayHaveCafRefs, pprCgInfo, - cgArity, cgCafInfo, vanillaCgInfo, - CgInfoEnv, lookupCgInfo, - setCgArity, - -- CAF info - CafInfo(..), ppCafInfo, setCafInfo, mayHaveCafRefs, - - -- Constructed Product Result Info - CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo, + CafInfo(..), cafInfo, ppCafInfo, setCafInfo, mayHaveCafRefs, -- Lambda-bound variable info LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo, hasNoLBVarInfo @@ -81,48 +77,48 @@ module IdInfo ( import CoreSyn -import Type ( Type, usOnce, eqUsage ) +import TyCon ( TyCon ) +import Class ( Class ) import PrimOp ( PrimOp ) -import NameEnv ( NameEnv, lookupNameEnv ) -import Name ( Name ) import Var ( Id ) import BasicTypes ( OccInfo(..), isFragileOcc, isDeadOcc, seqOccInfo, isLoopBreaker, InsideLam, insideLam, notInsideLam, OneBranch, oneBranch, notOneBranch, - Arity + Arity, + Activation(..) ) import DataCon ( DataCon ) import ForeignCall ( ForeignCall ) import FieldLabel ( FieldLabel ) -import Type ( usOnce, usMany ) -import Demand hiding( Demand ) -import qualified Demand -import NewDemand ( Demand(..), Keepity(..), Deferredness(..), DmdResult(..), - lazyDmd, topDmd, - StrictSig, mkStrictSig, - DmdType, mkTopDmdType - ) +import NewDemand import Outputable -import Util ( seqList ) +import Maybe ( isJust ) + +#ifdef OLD_STRICTNESS +import Name ( Name ) +import Demand hiding( Demand, seqDemand ) +import qualified Demand +import Util ( listLengthCmp ) import List ( replicate ) +#endif -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`, - `setCgInfo`, `setCafInfo`, - `setCgArity`, `setNewStrictnessInfo`, + `setAllStrictnessInfo`, `setNewDemandInfo` - -- infixl so you can say (id `set` a `set` b) +#ifdef OLD_STRICTNESS + , `setCprInfo` + , `setDemandInfo` + , `setStrictnessInfo` +#endif \end{code} %************************************************************************ @@ -134,35 +130,90 @@ infixl 1 `setDemandInfo`, To be removed later \begin{code} -mkNewStrictnessInfo :: Id -> Arity -> Demand.StrictnessInfo -> CprInfo -> StrictSig -mkNewStrictnessInfo id arity Demand.NoStrictnessInfo cpr - = mkStrictSig id arity $ - mkTopDmdType (replicate arity lazyDmd) (newRes False cpr) +-- setAllStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo +-- Set old and new strictness info +setAllStrictnessInfo info Nothing + = info { newStrictnessInfo = Nothing +#ifdef OLD_STRICTNESS + , strictnessInfo = NoStrictnessInfo + , cprInfo = NoCPRInfo +#endif + } + +setAllStrictnessInfo info (Just sig) + = info { newStrictnessInfo = Just sig +#ifdef OLD_STRICTNESS + , strictnessInfo = oldStrictnessFromNew sig + , cprInfo = cprInfoFromNewStrictness sig +#endif + } + +seqNewStrictnessInfo Nothing = () +seqNewStrictnessInfo (Just ty) = seqStrictSig ty + +pprNewStrictness Nothing = empty +pprNewStrictness (Just sig) = ftext FSLIT("Str:") <+> ppr sig + +#ifdef OLD_STRICTNESS +oldStrictnessFromNew :: StrictSig -> Demand.StrictnessInfo +oldStrictnessFromNew sig = mkStrictnessInfo (map oldDemand dmds, isBotRes res_info) + where + (dmds, res_info) = splitStrictSig sig -mkNewStrictnessInfo id arity (Demand.StrictnessInfo ds res) cpr - = mkStrictSig id arity $ - mkTopDmdType (take arity (map newDemand ds)) (newRes res cpr) +cprInfoFromNewStrictness :: StrictSig -> CprInfo +cprInfoFromNewStrictness sig = case strictSigResInfo sig of + RetCPR -> ReturnsCPR + other -> NoCPRInfo + +newStrictnessFromOld :: Name -> Arity -> Demand.StrictnessInfo -> CprInfo -> StrictSig +newStrictnessFromOld name arity (Demand.StrictnessInfo ds res) cpr + | listLengthCmp ds arity /= GT -- length ds <= arity -- Sometimes the old strictness analyser has more -- demands than the arity justifies + = mk_strict_sig name arity $ + mkTopDmdType (map newDemand ds) (newRes res cpr) + +newStrictnessFromOld name arity other cpr + = -- Either no strictness info, or arity is too small + -- In either case we can't say anything useful + mk_strict_sig name arity $ + mkTopDmdType (replicate arity lazyDmd) (newRes False cpr) + +mk_strict_sig name arity dmd_ty + = WARN( arity /= dmdTypeDepth dmd_ty, ppr name <+> (ppr arity $$ ppr 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 newDemand (WwLazy True) = Abs -newDemand (WwLazy False) = Lazy -newDemand WwStrict = Eval -newDemand (WwUnpack unpk ds) = Seq Drop Now (map newDemand ds) -newDemand WwPrim = Lazy -newDemand WwEnum = Eval +newDemand (WwLazy False) = lazyDmd +newDemand WwStrict = evalDmd +newDemand (WwUnpack unpk ds) = Eval (Prod (map newDemand ds)) +newDemand WwPrim = lazyDmd +newDemand WwEnum = evalDmd oldDemand :: NewDemand.Demand -> Demand.Demand -oldDemand Abs = WwLazy True -oldDemand Lazy = WwLazy False -oldDemand Eval = WwStrict -oldDemand (Seq _ _ ds) = WwUnpack True (map oldDemand ds) -oldDemand (Call _) = WwStrict +oldDemand Abs = WwLazy True +oldDemand Top = WwLazy False +oldDemand Bot = WwStrict +oldDemand (Box Bot) = WwStrict +oldDemand (Box Abs) = WwLazy False +oldDemand (Box (Eval _)) = WwStrict -- Pass box only +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} @@ -180,14 +231,17 @@ an IdInfo.hi-boot, but no Id.hi-boot, and GlobalIdDetails is imported data GlobalIdDetails = VanillaGlobal -- Imported from elsewhere, a default method Id. + | GenericOpId TyCon -- The to/from operations of a | RecordSelId FieldLabel -- The Id for a record selector - | DataConId DataCon -- The Id for a data constructor *worker* + | DataConWorkId DataCon -- The Id for a data constructor *worker* | DataConWrapId DataCon -- The Id for a data constructor *wrapper* -- [the only reasons we need to know is so that -- a) we can suppress printing a definition in the interface file -- b) when typechecking a pattern we can get from the -- Id back to the data con] + | ClassOpId Class -- An operation of a class + | PrimOpId PrimOp -- The Id for a primitive operator | FCallId ForeignCall -- The Id for a foreign call @@ -198,8 +252,10 @@ notGlobalId = NotGlobalId instance Outputable GlobalIdDetails where ppr NotGlobalId = ptext SLIT("[***NotGlobalId***]") ppr VanillaGlobal = ptext SLIT("[GlobalId]") - ppr (DataConId _) = ptext SLIT("[DataCon]") + ppr (GenericOpId _) = ptext SLIT("[GenericOp]") + ppr (DataConWorkId _) = ptext SLIT("[DataCon]") ppr (DataConWrapId _) = ptext SLIT("[DataConWrapper]") + ppr (ClassOpId _) = ptext SLIT("[ClassOp]") ppr (PrimOpId _) = ptext SLIT("[PrimOp]") ppr (FCallId _) = ptext SLIT("[ForeignCall]") ppr (RecordSelId _) = ptext SLIT("[RecSel]") @@ -228,21 +284,28 @@ 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 + cafInfo :: CafInfo, -- CAF info lbvarInfo :: LBVarInfo, -- Info about a lambda-bound variable inlinePragInfo :: InlinePragInfo, -- Inline pragma occInfo :: OccInfo, -- How it occurs - newStrictnessInfo :: Maybe StrictSig, - newDemandInfo :: Demand + newStrictnessInfo :: Maybe StrictSig, -- Reason for Maybe: the DmdAnal phase needs to + -- know whether whether this is the first visit, + -- so it can assign botSig. Other customers want + -- topSig. So Nothing is good. + + 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 -> () @@ -250,22 +313,24 @@ 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` + seqCaf (cafInfo info) `seq` + seqLBVar (lbvarInfo info) `seq` seqOccInfo (occInfo info) \end{code} @@ -273,15 +338,20 @@ Setters \begin{code} setWorkerInfo info wk = wk `seq` info { workerInfo = wk } -setSpecInfo info sp = PSEQ sp (info { specInfo = sp }) -setTyGenInfo info tg = tg `seq` info { tyGenInfo = tg } +setSpecInfo info sp = sp `seq` info { specInfo = sp } 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 - | isEvaldUnfolding uf && isStrict (demandInfo info) +setUnfoldingInfoLazily info uf -- Lazy variant to avoid looking at the + = -- unfolding of an imported Id unless necessary + info { unfoldingInfo = uf } -- (In this case the demand-zapping is redundant.) + +setUnfoldingInfo info uf + | isEvaldUnfolding uf -- If the unfolding is a value, the demand info may -- go pear-shaped, so we nuke it. Example: -- let x = (a,b) in @@ -291,21 +361,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, demandInfo = wwLazy } + = 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 } -setArityInfo info ar = info { arityInfo = Just ar } -setCgInfo info cg = info { cgInfo = cg } setCprInfo info cp = info { cprInfo = cp } -setLBVarInfo info lb = info { lbvarInfo = lb } +#endif + +setArityInfo info ar = info { arityInfo = ar } +setCafInfo info caf = info { cafInfo = caf } -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} @@ -313,27 +387,25 @@ setNewStrictnessInfo info dd = info { newStrictnessInfo = dd } vanillaIdInfo :: IdInfo vanillaIdInfo = IdInfo { - cgInfo = noCgInfo, + cafInfo = vanillaCafInfo, 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 = NoInlinePragInfo, + inlinePragInfo = AlwaysActive, occInfo = NoOccInfo, - newDemandInfo = topDmd, + newDemandInfo = Nothing, newStrictnessInfo = Nothing } -noCafNoTyGenIdInfo = vanillaIdInfo `setTyGenInfo` TyGenNever - `setCgInfo` (CgInfo 0 NoCafRefs) +noCafIdInfo = vanillaIdInfo `setCafInfo` NoCafRefs -- Used for built-in type Ids in MkId. - -- Many built-in things have fixed types, so we shouldn't - -- run around generalising them \end{code} @@ -348,7 +420,7 @@ of their arities; so it should not be asking... (but other things besides the code-generator need arity info!) \begin{code} -type ArityInfo = Maybe Arity +type ArityInfo = Arity -- A partial application of this Id to up to n-1 value arguments -- does essentially no work. That is not necessarily the -- same as saying that it has n leading lambdas, because coerces @@ -357,22 +429,10 @@ type ArityInfo = Maybe Arity -- The arity might increase later in the compilation process, if -- an extra lambda floats up to the binding site. -seqArity :: ArityInfo -> () -seqArity a = arityLowerBound a `seq` () - -exactArity = Just -unknownArity = Nothing +unknownArity = 0 :: Arity -arityLowerBound :: ArityInfo -> Arity -arityLowerBound Nothing = 0 -arityLowerBound (Just n) = n - -hasArity :: ArityInfo -> Bool -hasArity Nothing = False -hasArity other = True - -ppArityInfo Nothing = empty -ppArityInfo (Just arity) = hsep [ptext SLIT("Arity"), int arity] +ppArityInfo 0 = empty +ppArityInfo n = hsep [ptext SLIT("Arity"), int n] \end{code} %************************************************************************ @@ -382,111 +442,13 @@ ppArityInfo (Just arity) = hsep [ptext SLIT("Arity"), int arity] %************************************************************************ \begin{code} -data InlinePragInfo - = NoInlinePragInfo - | IMustNotBeINLINEd Bool -- True <=> came from an INLINE prag, False <=> came from a NOINLINE prag - (Maybe Int) -- Phase number from pragma, if any - deriving( Eq ) - -- The True, Nothing case doesn't need to be recorded - - -- SEE COMMENTS WITH CoreUnfold.blackListed on the - -- exact significance of the IMustNotBeINLINEd pragma - -isNeverInlinePrag :: InlinePragInfo -> Bool -isNeverInlinePrag (IMustNotBeINLINEd _ Nothing) = True -isNeverInlinePrag other = False - -neverInlinePrag :: InlinePragInfo -neverInlinePrag = IMustNotBeINLINEd True{-should be False? --SDM -} Nothing - -instance Outputable InlinePragInfo where - -- This is now parsed in interface files - ppr NoInlinePragInfo = empty - ppr other_prag = ptext SLIT("__U") <> pprInlinePragInfo other_prag - -pprInlinePragInfo NoInlinePragInfo = empty -pprInlinePragInfo (IMustNotBeINLINEd True Nothing) = empty -pprInlinePragInfo (IMustNotBeINLINEd True (Just n)) = brackets (int n) -pprInlinePragInfo (IMustNotBeINLINEd False Nothing) = brackets (char '!') -pprInlinePragInfo (IMustNotBeINLINEd False (Just n)) = brackets (char '!' <> int n) - -instance Show InlinePragInfo where - showsPrec p prag = showsPrecSDoc p (ppr prag) -\end{code} - - -%************************************************************************ -%* * -\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) +type InlinePragInfo = Activation + -- Tells when the inlining is active + -- When it is active the thing may be inlined, depending on how + -- big it is. + -- + -- If there was an INLINE pragma, then as a separate matter, the + -- RHS will have been made to look small with a CoreSyn Inline Note \end{code} @@ -498,7 +460,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 @@ -530,7 +492,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 @@ -554,42 +516,7 @@ wrapperArity (HasWorker _ a) = a %* * %************************************************************************ -CgInfo encapsulates calling-convention information produced by the code -generator. It is pasted into the IdInfo of each emitted Id by CoreTidy, -but only as a thunk --- the information is only actually produced further -downstream, by the code generator. - \begin{code} -data CgInfo = CgInfo - !Arity -- Exact arity for calling purposes - !CafInfo -#ifdef DEBUG - | NoCgInfo -- In debug mode we don't want a black hole here - -- See Id.idCgInfo - - -- noCgInfo is used for local Ids, which shouldn't need any CgInfo -noCgInfo = NoCgInfo -#else -noCgInfo = panic "NoCgInfo!" -#endif - -cgArity (CgInfo arity _) = arity -cgCafInfo (CgInfo _ caf_info) = caf_info - -setCafInfo info caf_info = - case cgInfo info of { CgInfo arity _ -> - info `setCgInfo` CgInfo arity caf_info } - -setCgArity info arity = - case cgInfo info of { CgInfo _ caf_info -> - info `setCgInfo` CgInfo arity caf_info } - -cgMayHaveCafRefs (CgInfo _ caf_info) = mayHaveCafRefs caf_info - -seqCg c = c `seq` () -- fields are strict anyhow - -vanillaCgInfo = CgInfo 0 MayHaveCafRefs -- Definitely safe - -- CafInfo is used to build Static Reference Tables (see simplStg/SRT.lhs). data CafInfo @@ -601,30 +528,17 @@ data CafInfo | NoCafRefs -- A function or static constructor -- that refers to no CAFs. +vanillaCafInfo = MayHaveCafRefs -- Definitely safe + mayHaveCafRefs MayHaveCafRefs = True mayHaveCafRefs _ = False seqCaf c = c `seq` () -pprCgInfo (CgInfo arity caf_info) = ppArity arity <+> ppCafInfo caf_info - -ppArity 0 = empty -ppArity n = hsep [ptext SLIT("__A"), int n] - -ppCafInfo NoCafRefs = ptext SLIT("__C") +ppCafInfo NoCafRefs = ptext SLIT("NoCafRefs") ppCafInfo MayHaveCafRefs = empty \end{code} -\begin{code} -type CgInfoEnv = NameEnv CgInfo - -lookupCgInfo :: NameEnv CgInfo -> Name -> CgInfo -lookupCgInfo env n = case lookupNameEnv env n of - Just info -> info - Nothing -> pprTrace "Urk! Not in CgInfo env" (ppr n) vanillaCgInfo -\end{code} - - %************************************************************************ %* * \subsection[cpr-IdInfo]{Constructed Product Result info about an @Id@} @@ -650,6 +564,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 @@ -660,9 +575,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 = () @@ -677,6 +590,7 @@ instance Outputable CprInfo where instance Show CprInfo where showsPrec p c = showsPrecSDoc p (ppr c) +#endif \end{code} @@ -687,45 +601,28 @@ instance Show CprInfo where %************************************************************************ 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. +var info. Sometimes we know whether the lambda binding this var is a +``one-shot'' lambda; that is, whether it is applied at most once. This information may be useful in optimisation, as computations may safely be floated inside such a lambda without risk of duplicating work. \begin{code} -data LBVarInfo - = NoLBVarInfo - - | LBVarInfo Type -- The lambda that binds this Id has this usage - -- annotation (i.e., if ==usOnce, then the - -- lambda is applied at most once). - -- The annotation's kind must be `$' - -- 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. +data LBVarInfo = NoLBVarInfo + | IsOneShotLambda -- The lambda is applied at most once). seqLBVar l = l `seq` () \end{code} \begin{code} -hasNoLBVarInfo NoLBVarInfo = True -hasNoLBVarInfo other = False +hasNoLBVarInfo NoLBVarInfo = True +hasNoLBVarInfo IsOneShotLambda = False noLBVarInfo = NoLBVarInfo --- 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 (LBVarInfo u) | u `eqUsage` usOnce - = getPprStyle $ \ sty -> - if ifaceStyle sty - then empty - else ptext SLIT("OneShot") - | otherwise - = empty +pprLBVarInfo IsOneShotLambda = ptext SLIT("OneShot") instance Outputable LBVarInfo where ppr = pprLBVarInfo @@ -746,29 +643,30 @@ part of an unsaturated lambda \begin{code} zapLamInfo :: IdInfo -> Maybe IdInfo -zapLamInfo info@(IdInfo {occInfo = occ, demandInfo = demand}) - | is_safe_occ && not (isStrict demand) +zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand}) + | is_safe_occ occ && is_safe_dmd demand = Nothing | otherwise - = Just (info {occInfo = safe_occ, - demandInfo = wwLazy}) + = 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 {demandInfo = demand}) - | not (isStrict demand) = Nothing - | otherwise = Just (info {demandInfo = wwLazy}) +zapDemandInfo info@(IdInfo {newDemandInfo = dmd}) + | isJust dmd = Just (info {newDemandInfo = Nothing}) + | otherwise = Nothing \end{code} @@ -830,8 +728,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}