X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FIdInfo.lhs;h=a8f16ae7f375ed3973c8d20902d540de4c9b1136;hb=4161ba13916463f8e67259498eacf22744160e1f;hp=e7056de0cb1ff8f68cacd55adb8eeebfddcf32d1;hpb=a127213c1890584702075d732d7bb9887113e4ff;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs index e7056de..a8f16ae 100644 --- a/ghc/compiler/basicTypes/IdInfo.lhs +++ b/ghc/compiler/basicTypes/IdInfo.lhs @@ -10,14 +10,14 @@ Haskell. [WDP 94/11]) module IdInfo ( IdInfo, -- Abstract - vanillaIdInfo, mkIdInfo, seqIdInfo, megaSeqIdInfo, + vanillaIdInfo, constantIdInfo, mkIdInfo, seqIdInfo, megaSeqIdInfo, -- Zapping - zapFragileInfo, zapLamInfo, zapSpecPragInfo, copyIdInfo, + zapFragileInfo, zapLamInfo, zapSpecPragInfo, shortableIdInfo, copyIdInfo, -- Flavour IdFlavour(..), flavourInfo, - setNoDiscardInfo, + setNoDiscardInfo, setFlavourInfo, ppFlavourInfo, -- Arity @@ -29,9 +29,13 @@ module IdInfo ( StrictnessInfo(..), mkStrictnessInfo, noStrictnessInfo, ppStrictnessInfo,isBottomingStrictness, - strictnessInfo, setStrictnessInfo, + -- Usage generalisation + TyGenInfo(..), + tyGenInfo, setTyGenInfo, + noTyGenInfo, isNoTyGenInfo, ppTyGenInfo, tyGenInfoString, + -- Worker WorkerInfo(..), workerExists, wrapperArity, workerId, workerInfo, setWorkerInfo, ppWorkerInfo, @@ -45,19 +49,16 @@ module IdInfo ( -- Inline prags InlinePragInfo(..), inlinePragInfo, setInlinePragInfo, pprInlinePragInfo, + isNeverInlinePrag, neverInlinePrag, -- Occurrence info - OccInfo(..), isFragileOccInfo, + OccInfo(..), isFragileOcc, isDeadOcc, isLoopBreaker, InsideLam, OneBranch, insideLam, notInsideLam, oneBranch, notOneBranch, occInfo, setOccInfo, -- Specialisation specInfo, setSpecInfo, - -- Update - UpdateInfo, UpdateSpec, - mkUpdateInfo, updateInfo, updateInfoMaybe, ppUpdateInfo, setUpdateInfo, - -- CAF info CafInfo(..), cafInfo, setCafInfo, ppCafInfo, @@ -72,21 +73,23 @@ module IdInfo ( import CoreSyn +import Type ( Type, usOnce ) import PrimOp ( PrimOp ) import Var ( Id ) -import BasicTypes ( OccInfo(..), isFragileOccInfo, seqOccInfo, +import BasicTypes ( OccInfo(..), isFragileOcc, isDeadOcc, seqOccInfo, isLoopBreaker, InsideLam, insideLam, notInsideLam, OneBranch, oneBranch, notOneBranch, Arity ) import DataCon ( DataCon ) import FieldLabel ( FieldLabel ) +import Type ( usOnce, usMany ) import Demand -- Lots of stuff import Outputable -import Maybe ( isJust ) +import Util ( seqList ) -infixl 1 `setUpdateInfo`, - `setDemandInfo`, +infixl 1 `setDemandInfo`, + `setTyGenInfo`, `setStrictnessInfo`, `setSpecInfo`, `setArityInfo`, @@ -94,6 +97,7 @@ infixl 1 `setUpdateInfo`, `setUnfoldingInfo`, `setCprInfo`, `setWorkerInfo`, + `setLBVarInfo`, `setCafInfo`, `setOccInfo` -- infixl so you can say (id `set` a `set` b) @@ -123,10 +127,10 @@ data IdInfo arityInfo :: ArityInfo, -- Its arity demandInfo :: Demand, -- Whether or not it is definitely demanded specInfo :: CoreRules, -- Specialisations of this function which exist + tyGenInfo :: TyGenInfo, -- Restrictions on usage-generalisation of this Id 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 @@ -143,6 +147,7 @@ megaSeqIdInfo info seqArity (arityInfo info) `seq` seqDemand (demandInfo info) `seq` seqRules (specInfo info) `seq` + seqTyGenInfo (tyGenInfo info) `seq` seqStrictnessInfo (strictnessInfo info) `seq` seqWorker (workerInfo info) `seq` @@ -159,18 +164,33 @@ megaSeqIdInfo info Setters \begin{code} +setFlavourInfo info fl = fl `seq` info { flavourInfo = fl } setWorkerInfo info wk = wk `seq` info { workerInfo = wk } setSpecInfo info sp = PSEQ sp (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 } setStrictnessInfo info st = st `seq` info { strictnessInfo = st } -- Try to avoid spack leaks by seq'ing -setUnfoldingInfo info uf = info { unfoldingInfo = uf } +setUnfoldingInfo info uf + | isEvaldUnfolding uf && isStrict (demandInfo info) + -- If the unfolding is a value, the demand info may + -- go pear-shaped, so we nuke it. Example: + -- let x = (a,b) in + -- case x of (p,q) -> h p q x + -- Here x is certainly demanded. But after we've nuked + -- the case, we'll get just + -- 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 } + + | otherwise -- We do *not* seq on the unfolding info, For some reason, doing so -- actually increases residency significantly. + = info { unfoldingInfo = uf } -setUpdateInfo info ud = info { updateInfo = ud } setDemandInfo info dd = info { demandInfo = dd } setArityInfo info ar = info { arityInfo = ar } setCafInfo info cf = info { cafInfo = cf } @@ -178,7 +198,7 @@ setCprInfo info cp = info { cprInfo = cp } setLBVarInfo info lb = info { lbvarInfo = lb } setNoDiscardInfo info = case flavourInfo info of - VanillaId -> info { flavourInfo = NoDiscardId } + VanillaId -> info { flavourInfo = ExportedId } other -> info zapSpecPragInfo info = case flavourInfo info of SpecPragmaId -> info { flavourInfo = VanillaId } @@ -190,16 +210,19 @@ zapSpecPragInfo info = case flavourInfo info of vanillaIdInfo :: IdInfo vanillaIdInfo = mkIdInfo VanillaId +constantIdInfo :: IdInfo +constantIdInfo = mkIdInfo ConstantId + mkIdInfo :: IdFlavour -> IdInfo mkIdInfo flv = IdInfo { flavourInfo = flv, arityInfo = UnknownArity, demandInfo = wwLazy, specInfo = emptyCoreRules, + tyGenInfo = noTyGenInfo, workerInfo = NoWorker, strictnessInfo = NoStrictnessInfo, unfoldingInfo = noUnfolding, - updateInfo = NoUpdateInfo, cafInfo = MayHaveCafRefs, cprInfo = NoCPRInfo, lbvarInfo = NoLBVarInfo, @@ -217,7 +240,13 @@ mkIdInfo flv = IdInfo { \begin{code} data IdFlavour - = VanillaId -- Most Ids are like this + = VanillaId -- Locally defined, not exported + | ExportedId -- Locally defined, exported + | SpecPragmaId -- Locally defined, RHS holds specialised call + + | ConstantId -- Imported from elsewhere, or a dictionary function, + -- default method Id. + | DataConId 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 @@ -226,17 +255,17 @@ data IdFlavour -- Id back to the data con] | PrimOpId PrimOp -- The Id for a primitive operator | 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 ExportedId = ptext SLIT("[Exported]") +ppFlavourInfo SpecPragmaId = ptext SLIT("[SpecPrag]") +ppFlavourInfo ConstantId = ptext SLIT("[Constant]") ppFlavourInfo (DataConId _) = ptext SLIT("[DataCon]") ppFlavourInfo (DataConWrapId _) = ptext SLIT("[DataConWrapper]") ppFlavourInfo (PrimOpId _) = ptext SLIT("[PrimOp]") ppFlavourInfo (RecordSelId _) = ptext SLIT("[RecSel]") -ppFlavourInfo SpecPragmaId = ptext SLIT("[SpecPrag]") -ppFlavourInfo NoDiscardId = ptext SLIT("[NoDiscard]") seqFlavour :: IdFlavour -> () seqFlavour f = f `seq` () @@ -271,10 +300,15 @@ data ArityInfo -- function; it's already been compiled and we know its -- arity for sure. - | ArityAtLeast Arity -- Arity is this or greater. We attach this arity to + | ArityAtLeast 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 + -- may get in the way. + -- functions in the module being compiled. Their arity -- might increase later in the compilation process, if -- an extra lambda floats up to the binding site. + deriving( Eq ) seqArity :: ArityInfo -> () seqArity a = arityLowerBound a `seq` () @@ -308,8 +342,19 @@ 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 @@ -327,6 +372,83 @@ instance Show InlinePragInfo where %************************************************************************ +%* * +\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 + + deriving ( Eq ) +\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 == usOnce = '1' -- chars with identity + | u == 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@} %* * @@ -346,9 +468,7 @@ There might not be a worker, even for a strict function, because: data WorkerInfo = NoWorker | HasWorker Id Arity -- The Arity is the arity of the *wrapper* at the moment of the - -- w/w split. It had better be the same as the arity of the wrapper - -- at the moment it is spat into the interface file. - -- This Arity just lets us make a (hopefully redundant) sanity check + -- w/w split. See comments in MkIface.ifaceId, with the 'Worker' code. seqWorker :: WorkerInfo -> () seqWorker (HasWorker id _) = id `seq` () @@ -373,40 +493,6 @@ wrapperArity (HasWorker _ a) = a %************************************************************************ %* * -\subsection[update-IdInfo]{Update-analysis info about an @Id@} -%* * -%************************************************************************ - -\begin{code} -data UpdateInfo - = NoUpdateInfo - | SomeUpdateInfo UpdateSpec - deriving (Eq, Ord) - -- we need Eq/Ord to cross-chk update infos in interfaces - --- the form in which we pass update-analysis info between modules: -type UpdateSpec = [Int] -\end{code} - -\begin{code} -mkUpdateInfo = SomeUpdateInfo - -updateInfoMaybe NoUpdateInfo = Nothing -updateInfoMaybe (SomeUpdateInfo []) = Nothing -updateInfoMaybe (SomeUpdateInfo u) = Just u -\end{code} - -Text instance so that the update annotations can be read in. - -\begin{code} -ppUpdateInfo NoUpdateInfo = empty -ppUpdateInfo (SomeUpdateInfo []) = empty -ppUpdateInfo (SomeUpdateInfo spec) = (<>) (ptext SLIT("__UA ")) (hcat (map int spec)) - -- was "__U "; changed to avoid conflict with unfoldings. KSW 1999-07. -\end{code} - -%************************************************************************ -%* * \subsection[CAF-IdInfo]{CAF-related information} %* * %************************************************************************ @@ -509,8 +595,10 @@ work. data LBVarInfo = NoLBVarInfo - | IsOneShotLambda -- The lambda that binds this Id is applied - -- at most once + | 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. @@ -524,9 +612,13 @@ 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 IsOneShotLambda = getPprStyle $ \ sty -> - if ifaceStyle sty then empty - else ptext SLIT("OneShot") +pprLBVarInfo (LBVarInfo u) | u == usOnce + = getPprStyle $ \ sty -> + if ifaceStyle sty + then empty + else ptext SLIT("OneShot") + | otherwise + = empty instance Outputable LBVarInfo where ppr = pprLBVarInfo @@ -554,7 +646,7 @@ zapFragileInfo info@(IdInfo {occInfo = occ, workerInfo = wrkr, specInfo = rules, unfoldingInfo = unfolding}) - | not (isFragileOccInfo occ) + | not (isFragileOcc occ) -- 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 @@ -620,26 +712,60 @@ copyIdInfo is used when shorting out a top-level binding 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, and the result is attached to f +BUT (a) we must be careful about messing up rules + (b) we must ensure f's IdInfo ends up right + +(a) Messing up the rules +~~~~~~~~~~~~~~~~~~~~ +The example that went bad on me was this one: + + iterate :: (a -> a) -> a -> [a] + iterate = iterateList + + iterateFB c f x = x `c` iterateFB c f (f x) + iterateList f x = x : iterateList f (f x) + + {-# RULES + "iterate" forall f x. iterate f x = build (\c _n -> iterateFB c f x) + "iterateFB" iterateFB (:) = iterateList + #-} + +This got shorted out to: + + iterateList :: (a -> a) -> a -> [a] + iterateList = iterate + + iterateFB c f x = x `c` iterateFB c f (f x) + iterate f x = x : iterate f (f x) + + {-# RULES + "iterate" forall f x. iterate f x = build (\c _n -> iterateFB c f x) + "iterateFB" iterateFB (:) = iterate + #-} + +And now we get an infinite loop in the rule system + iterate f x -> build (\cn -> iterateFB c f x + -> iterateFB (:) f x + -> iterate f x + +Tiresome solution: don't do shorting out if f has rewrite rules. +Hence shortableIdInfo. + +(b) Keeping the IdInfo right +~~~~~~~~~~~~~~~~~~~~~~~~ +We want to move strictness/worker info from f_local to f, but keep the rest. +Hence copyIdInfo. \begin{code} -copyIdInfo :: IdInfo -- From - -> IdInfo -- To - -> IdInfo -- To, updated with stuff from From; except flavour unchanged -copyIdInfo from to = from { flavourInfo = flavourInfo to, - specInfo = specInfo to, - inlinePragInfo = inlinePragInfo to +shortableIdInfo :: IdInfo -> Bool +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 } - -- It's important to preserve the inline pragma on 'f'; e.g. consider - -- {-# NOINLINE f #-} - -- f = local - -- - -- similarly, transformation rules may be attached to f - -- and we want to preserve them. - -- - -- On the other hand, we want the strictness info from f_local. \end{code}