X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FIdInfo.lhs;h=52a3d5fc2b486efc88504a5b1aadbe625024c860;hb=f6cd95ff9a2bddbd78682dcd9287aec7d152cc13;hp=ca1e2b3c707665c1f550c78b4ef8c0aa809feea8;hpb=1c62b517711ac232a8024d91fd4b317a6804d28e;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs index ca1e2b3..52a3d5f 100644 --- a/ghc/compiler/basicTypes/IdInfo.lhs +++ b/ghc/compiler/basicTypes/IdInfo.lhs @@ -8,23 +8,25 @@ Haskell. [WDP 94/11]) \begin{code} module IdInfo ( - IdInfo, -- Abstract + GlobalIdDetails(..), notGlobalId, -- Not abstract - vanillaIdInfo, constantIdInfo, mkIdInfo, seqIdInfo, megaSeqIdInfo, + IdInfo, -- Abstract + vanillaIdInfo, noCafNoTyGenIdInfo, + seqIdInfo, megaSeqIdInfo, -- Zapping - zapFragileInfo, zapLamInfo, zapSpecPragInfo, shortableIdInfo, copyIdInfo, - - -- Flavour - IdFlavour(..), flavourInfo, makeConstantFlavour, - setNoDiscardInfo, setFlavourInfo, - ppFlavourInfo, + zapLamInfo, zapDemandInfo, + shortableIdInfo, copyIdInfo, -- Arity - ArityInfo(..), - exactArity, atLeastArity, unknownArity, hasArity, + ArityInfo, + exactArity, unknownArity, hasArity, arityInfo, setArityInfo, ppArityInfo, arityLowerBound, + -- New demand and strictness info + newStrictnessInfo, setNewStrictnessInfo, mkNewStrictnessInfo, + newDemandInfo, setNewDemandInfo, newDemand, oldDemand, + -- Strictness; imported from Demand StrictnessInfo(..), mkStrictnessInfo, noStrictnessInfo, @@ -59,22 +61,30 @@ module IdInfo ( -- Specialisation specInfo, setSpecInfo, + -- CG info + CgInfo(..), cgInfo, setCgInfo, cgMayHaveCafRefs, pprCgInfo, + cgArity, cgCafInfo, vanillaCgInfo, + CgInfoEnv, lookupCgInfo, + setCgArity, + -- CAF info - CafInfo(..), cafInfo, setCafInfo, mayHaveCafRefs, ppCafInfo, + CafInfo(..), ppCafInfo, setCafInfo, mayHaveCafRefs, -- Constructed Product Result Info CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo, -- Lambda-bound variable info - LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo + LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo, hasNoLBVarInfo ) where #include "HsVersions.h" import CoreSyn -import Type ( Type, usOnce ) +import Type ( Type, usOnce, eqUsage ) import PrimOp ( PrimOp ) +import NameEnv ( NameEnv, lookupNameEnv ) +import Name ( Name ) import Var ( Id ) import BasicTypes ( OccInfo(..), isFragileOcc, isDeadOcc, seqOccInfo, isLoopBreaker, InsideLam, insideLam, notInsideLam, @@ -82,11 +92,18 @@ import BasicTypes ( OccInfo(..), isFragileOcc, isDeadOcc, seqOccInfo, isLoopBrea Arity ) import DataCon ( DataCon ) +import ForeignCall ( ForeignCall ) import FieldLabel ( FieldLabel ) import Type ( usOnce, usMany ) -import Demand -- Lots of stuff +import Demand hiding( Demand ) +import NewDemand ( Demand(..), Keepity(..), Deferredness(..), DmdResult(..), + lazyDmd, topDmd, + StrictSig, mkStrictSig, + DmdType, mkTopDmdType + ) import Outputable import Util ( seqList ) +import List ( replicate ) infixl 1 `setDemandInfo`, `setTyGenInfo`, @@ -98,19 +115,106 @@ infixl 1 `setDemandInfo`, `setCprInfo`, `setWorkerInfo`, `setLBVarInfo`, + `setOccInfo`, + `setCgInfo`, `setCafInfo`, - `setOccInfo` + `setCgArity`, + `setNewStrictnessInfo`, + `setNewDemandInfo` -- infixl so you can say (id `set` a `set` b) \end{code} +%************************************************************************ +%* * +\subsection{New strictness info} +%* * +%************************************************************************ + +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) + +mkNewStrictnessInfo id arity (Demand.StrictnessInfo ds res) cpr + = mkStrictSig id arity $ + mkTopDmdType (take arity (map newDemand ds)) (newRes res cpr) + -- Sometimes the old strictness analyser has more + -- demands than the arity justifies + +newRes True _ = BotRes +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 + +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 +\end{code} + + +%************************************************************************ +%* * +\subsection{GlobalIdDetails +%* * +%************************************************************************ + +This type is here (rather than in Id.lhs) mainly because there's +an IdInfo.hi-boot, but no Id.hi-boot, and GlobalIdDetails is imported +(recursively) by Var.lhs. + +\begin{code} +data GlobalIdDetails + = VanillaGlobal -- Imported from elsewhere, a default method Id. + + | RecordSelId FieldLabel -- The Id for a record selector + | 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 + -- 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] + + | PrimOpId PrimOp -- The Id for a primitive operator + | FCallId ForeignCall -- The Id for a foreign call + + | NotGlobalId -- Used as a convenient extra return value from globalIdDetails + +notGlobalId = NotGlobalId + +instance Outputable GlobalIdDetails where + ppr NotGlobalId = ptext SLIT("[***NotGlobalId***]") + ppr VanillaGlobal = ptext SLIT("[GlobalId]") + ppr (DataConId _) = ptext SLIT("[DataCon]") + ppr (DataConWrapId _) = ptext SLIT("[DataConWrapper]") + ppr (PrimOpId _) = ptext SLIT("[PrimOp]") + ppr (FCallId _) = ptext SLIT("[ForeignCall]") + ppr (RecordSelId _) = ptext SLIT("[RecSel]") +\end{code} + + +%************************************************************************ +%* * +\subsection{The main IdInfo type} +%* * +%************************************************************************ + 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. @@ -123,19 +227,21 @@ case. KSW 1999-04). \begin{code} data IdInfo = IdInfo { - flavourInfo :: IdFlavour, -- NOT OPTIONAL arityInfo :: ArityInfo, -- Its arity - demandInfo :: Demand, -- Whether or not it is definitely demanded + demandInfo :: Demand.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 - cafInfo :: CafInfo, -- whether it refers (indirectly) to any CAFs + 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 + occInfo :: OccInfo, -- How it occurs + + newStrictnessInfo :: Maybe StrictSig, + newDemandInfo :: Demand } seqIdInfo :: IdInfo -> () @@ -143,8 +249,7 @@ seqIdInfo (IdInfo {}) = () megaSeqIdInfo :: IdInfo -> () megaSeqIdInfo info - = seqFlavour (flavourInfo info) `seq` - seqArity (arityInfo info) `seq` + = seqArity (arityInfo info) `seq` seqDemand (demandInfo info) `seq` seqRules (specInfo info) `seq` seqTyGenInfo (tyGenInfo info) `seq` @@ -155,7 +260,9 @@ megaSeqIdInfo info -- Omitting this improves runtimes a little, presumably because -- some unfoldings are not calculated at all - seqCaf (cafInfo info) `seq` +-- 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) @@ -164,7 +271,6 @@ 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 } @@ -192,39 +298,22 @@ setUnfoldingInfo info uf = info { unfoldingInfo = uf } setDemandInfo info dd = info { demandInfo = dd } -setArityInfo info ar = info { arityInfo = ar } -setCafInfo info cf = info { cafInfo = cf } +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 } -setNoDiscardInfo info = case flavourInfo info of - VanillaId -> info { flavourInfo = ExportedId } - other -> info -zapSpecPragInfo info = case flavourInfo info of - SpecPragmaId -> info { flavourInfo = VanillaId } - other -> info +setNewDemandInfo info dd = info { newDemandInfo = dd } +setNewStrictnessInfo info dd = info { newStrictnessInfo = dd } \end{code} \begin{code} vanillaIdInfo :: IdInfo - -- Used for locally-defined Ids - -- We are going to calculate correct CAF information at the end -vanillaIdInfo = mkIdInfo VanillaId NoCafRefs - -constantIdInfo :: IdInfo - -- Used for imported Ids - -- The default is that they *do* have CAFs; an interface-file pragma - -- may say "oh no it doesn't", but in the absence of such a pragma - -- we'd better assume it does -constantIdInfo = mkIdInfo ConstantId MayHaveCafRefs - -mkIdInfo :: IdFlavour -> CafInfo -> IdInfo -mkIdInfo flv caf +vanillaIdInfo = IdInfo { - flavourInfo = flv, - cafInfo = caf, - arityInfo = UnknownArity, + cgInfo = noCgInfo, + arityInfo = unknownArity, demandInfo = wwLazy, specInfo = emptyCoreRules, tyGenInfo = noTyGenInfo, @@ -234,76 +323,18 @@ mkIdInfo flv caf cprInfo = NoCPRInfo, lbvarInfo = NoLBVarInfo, inlinePragInfo = NoInlinePragInfo, - occInfo = NoOccInfo + occInfo = NoOccInfo, + newDemandInfo = topDmd, + newStrictnessInfo = Nothing } -\end{code} - - -%************************************************************************ -%* * -\subsection{Flavour} -%* * -%************************************************************************ -\begin{code} -data IdFlavour - = VanillaId -- Locally defined, not exported - | ExportedId -- Locally defined, exported - | SpecPragmaId -- Locally defined, RHS holds specialised call - - | ConstantId -- Imported from elsewhere, or a default method Id. - - | DictFunId -- We flag dictionary functions so that we can - -- conveniently extract the DictFuns from a set of - -- bindings when building a module's interface - - | 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 - -- 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] - | PrimOpId PrimOp -- The Id for a primitive operator - | RecordSelId FieldLabel -- The Id for a record selector - - -makeConstantFlavour :: IdFlavour -> IdFlavour -makeConstantFlavour flavour = new_flavour - where new_flavour = case flavour of - VanillaId -> ConstantId - ExportedId -> ConstantId - ConstantId -> ConstantId -- e.g. Default methods - DictFunId -> DictFunId - flavour -> pprTrace "makeConstantFlavour" - (ppFlavourInfo flavour) - flavour - - -ppFlavourInfo :: IdFlavour -> SDoc -ppFlavourInfo VanillaId = empty -ppFlavourInfo ExportedId = ptext SLIT("[Exported]") -ppFlavourInfo SpecPragmaId = ptext SLIT("[SpecPrag]") -ppFlavourInfo ConstantId = ptext SLIT("[Constant]") -ppFlavourInfo DictFunId = ptext SLIT("[DictFun]") -ppFlavourInfo (DataConId _) = ptext SLIT("[DataCon]") -ppFlavourInfo (DataConWrapId _) = ptext SLIT("[DataConWrapper]") -ppFlavourInfo (PrimOpId _) = ptext SLIT("[PrimOp]") -ppFlavourInfo (RecordSelId _) = ptext SLIT("[RecSel]") - -seqFlavour :: IdFlavour -> () -seqFlavour f = f `seq` () +noCafNoTyGenIdInfo = vanillaIdInfo `setTyGenInfo` TyGenNever + `setCgInfo` (CgInfo 0 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} -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. - %************************************************************************ %* * @@ -316,42 +347,31 @@ 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 +type ArityInfo = Maybe 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. - | ArityExactly Arity -- Arity is exactly this. We use this when importing a - -- function; it's already been compiled and we know its - -- arity for sure. - - | 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 ) + -- 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 = ArityExactly -atLeastArity = ArityAtLeast -unknownArity = UnknownArity +exactArity = Just +unknownArity = Nothing arityLowerBound :: ArityInfo -> Arity -arityLowerBound UnknownArity = 0 -arityLowerBound (ArityAtLeast n) = n -arityLowerBound (ArityExactly n) = n +arityLowerBound Nothing = 0 +arityLowerBound (Just n) = n hasArity :: ArityInfo -> Bool -hasArity UnknownArity = False -hasArity other = True +hasArity Nothing = False +hasArity other = True -ppArityInfo UnknownArity = empty -ppArityInfo (ArityExactly arity) = hsep [ptext SLIT("__A"), int arity] -ppArityInfo (ArityAtLeast arity) = hsep [ptext SLIT("__AL"), int arity] +ppArityInfo Nothing = empty +ppArityInfo (Just arity) = hsep [ptext SLIT("Arity"), int arity] \end{code} %************************************************************************ @@ -425,8 +445,6 @@ data TyGenInfo -- 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 @@ -458,9 +476,9 @@ 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. + 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 @@ -486,6 +504,23 @@ There might not be a worker, even for a strict function, because: for w/w split (b) the strictness info might be "SSS" or something, so no w/w split. +Sometimes the arity of a wrapper changes from the original arity from +which it was generated, so we always emit the "original" arity into +the interface file, as part of the worker info. + +How can this happen? Sometimes we get + f = coerce t (\x y -> $wf x y) +at the moment of w/w split; but the eta reducer turns it into + f = coerce t $wf +which is perfectly fine except that the exposed arity so far as +the code generator is concerned (zero) differs from the arity +when we did the split (2). + +All this arises because we use 'arity' to mean "exactly how many +top level lambdas are there" in interface files; but during the +compilation of this module it means "how many things can I apply +this to". + \begin{code} data WorkerInfo = NoWorker @@ -500,8 +535,6 @@ seqWorker NoWorker = () ppWorkerInfo NoWorker = empty ppWorkerInfo (HasWorker wk_id _) = ptext SLIT("__P") <+> ppr wk_id -noWorkerInfo = NoWorker - workerExists :: WorkerInfo -> Bool workerExists NoWorker = False workerExists (HasWorker _ _) = True @@ -516,14 +549,48 @@ wrapperArity (HasWorker _ a) = a %************************************************************************ %* * -\subsection[CAF-IdInfo]{CAF-related information} +\subsection[CG-IdInfo]{Code generator-related information} %* * %************************************************************************ -This information is used to build Static Reference Tables (see -simplStg/ComputeSRT.lhs). +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 = MayHaveCafRefs -- either: -- (1) A function or static constructor @@ -533,19 +600,29 @@ data CafInfo | NoCafRefs -- A function or static constructor -- that refers to no CAFs. --- LATER: not sure how easy this is... --- | OneCafRef Id +mayHaveCafRefs MayHaveCafRefs = True +mayHaveCafRefs _ = False +seqCaf c = c `seq` () -mayHaveCafRefs MayHaveCafRefs = True -mayHaveCafRefs _ = False +pprCgInfo (CgInfo arity caf_info) = ppArity arity <+> ppCafInfo caf_info -seqCaf c = c `seq` () +ppArity 0 = empty +ppArity n = hsep [ptext SLIT("__A"), int n] ppCafInfo NoCafRefs = ptext SLIT("__C") 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} + %************************************************************************ %* * @@ -633,12 +710,15 @@ seqLBVar l = l `seq` () \end{code} \begin{code} +hasNoLBVarInfo NoLBVarInfo = True +hasNoLBVarInfo other = 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 == usOnce +pprLBVarInfo (LBVarInfo u) | u `eqUsage` usOnce = getPprStyle $ \ sty -> if ifaceStyle sty then empty @@ -660,58 +740,6 @@ instance Show LBVarInfo where %* * %************************************************************************ -zapFragileInfo 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.) - -Hoever, we REMEMBER loop-breaker and dead-variable information. The loop-breaker -information is used (for example) in MkIface to avoid exposing the unfolding of -a loop breaker. - -\begin{code} -zapFragileInfo :: IdInfo -> Maybe IdInfo -zapFragileInfo info@(IdInfo {occInfo = occ, - workerInfo = wrkr, - specInfo = rules, - unfoldingInfo = unfolding}) - | 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 - -- We don't zap deadness or loop-breaker-ness. - -- The latter is important because it tells MkIface not to - -- spit out an inlining for the thing. The former doesn't - -- seem so important, but there's no harm. - - && isEmptyCoreRules rules - -- Specialisations would need substituting. They get pinned - -- back on separately. - - && not (workerExists wrkr) - - && 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 {occInfo = robust_occ_info, - workerInfo = noWorkerInfo, - specInfo = emptyCoreRules, - unfoldingInfo = noUnfolding}) - where - -- It's important to keep the loop-breaker info, - -- because the substitution doesn't remember it. - robust_occ_info = case occ of - OneOcc _ _ -> NoOccInfo - other -> occ -\end{code} - @zapLamInfo@ is used for lambda binders that turn out to to be part of an unsaturated lambda @@ -735,6 +763,13 @@ zapLamInfo info@(IdInfo {occInfo = occ, demandInfo = demand}) other -> occ \end{code} +\begin{code} +zapDemandInfo :: IdInfo -> Maybe IdInfo +zapDemandInfo info@(IdInfo {demandInfo = demand}) + | not (isStrict demand) = Nothing + | otherwise = Just (info {demandInfo = wwLazy}) +\end{code} + copyIdInfo is used when shorting out a top-level binding f_local = BIG @@ -775,7 +810,7 @@ This got shorted out to: #-} And now we get an infinite loop in the rule system - iterate f x -> build (\cn -> iterateFB c f x + iterate f x -> build (\cn -> iterateFB c f x) -> iterateFB (:) f x -> iterate f x