2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
4 \section[IdInfo]{@IdInfos@: Non-essential information about @Ids@}
6 (And a pretty good illustration of quite a few things wrong with
11 GlobalIdDetails(..), notGlobalId, -- Not abstract
14 vanillaIdInfo, noCafNoTyGenIdInfo,
15 seqIdInfo, megaSeqIdInfo,
18 zapLamInfo, zapDemandInfo,
19 shortableIdInfo, copyIdInfo,
24 arityInfo, setArityInfo, ppArityInfo,
26 -- New demand and strictness info
27 newStrictnessInfo, setNewStrictnessInfo,
28 newDemandInfo, setNewDemandInfo,
30 -- Strictness; imported from Demand
32 mkStrictnessInfo, noStrictnessInfo,
33 ppStrictnessInfo,isBottomingStrictness,
36 -- Usage generalisation
38 tyGenInfo, setTyGenInfo,
39 noTyGenInfo, isNoTyGenInfo, ppTyGenInfo, tyGenInfoString,
42 WorkerInfo(..), workerExists, wrapperArity, workerId,
43 workerInfo, setWorkerInfo, ppWorkerInfo,
46 unfoldingInfo, setUnfoldingInfo,
49 -- Old DemandInfo and StrictnessInfo
50 demandInfo, setDemandInfo,
51 strictnessInfo, setStrictnessInfo,
52 cprInfoFromNewStrictness,
53 oldStrictnessFromNew, newStrictnessFromOld,
56 -- Constructed Product Result Info
57 CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo,
62 inlinePragInfo, setInlinePragInfo,
65 OccInfo(..), isFragileOcc, isDeadOcc, isLoopBreaker,
66 InsideLam, OneBranch, insideLam, notInsideLam, oneBranch, notOneBranch,
70 specInfo, setSpecInfo,
73 CgInfo(..), cgInfo, setCgInfo, pprCgInfo,
74 cgCafInfo, vanillaCgInfo,
75 CgInfoEnv, lookupCgInfo,
78 CafInfo(..), ppCafInfo, setCafInfo, mayHaveCafRefs,
80 -- Lambda-bound variable info
81 LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo, hasNoLBVarInfo
84 #include "HsVersions.h"
88 import Type ( Type, usOnce, eqUsage )
89 import PrimOp ( PrimOp )
90 import NameEnv ( NameEnv, lookupNameEnv )
93 import BasicTypes ( OccInfo(..), isFragileOcc, isDeadOcc, seqOccInfo, isLoopBreaker,
94 InsideLam, insideLam, notInsideLam,
95 OneBranch, oneBranch, notOneBranch,
99 import DataCon ( DataCon )
100 import ForeignCall ( ForeignCall )
101 import FieldLabel ( FieldLabel )
102 import Type ( usOnce, usMany )
103 import Demand hiding( Demand, seqDemand )
104 import qualified Demand
107 import Util ( seqList, listLengthCmp )
108 import List ( replicate )
110 -- infixl so you can say (id `set` a `set` b)
111 infixl 1 `setTyGenInfo`,
121 `setNewStrictnessInfo`,
122 `setAllStrictnessInfo`,
124 #ifdef OLD_STRICTNESS
127 , `setStrictnessInfo`
131 %************************************************************************
133 \subsection{New strictness info}
135 %************************************************************************
140 -- setAllStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo
141 -- Set old and new strictness info
142 setAllStrictnessInfo info Nothing
143 = info { newStrictnessInfo = Nothing
144 #ifdef OLD_STRICTNESS
145 , strictnessInfo = NoStrictnessInfo
146 , cprInfo = NoCPRInfo
150 setAllStrictnessInfo info (Just sig)
151 = info { newStrictnessInfo = Just sig
152 #ifdef OLD_STRICTNESS
153 , strictnessInfo = oldStrictnessFromNew sig
154 , cprInfo = cprInfoFromNewStrictness sig
158 seqNewStrictnessInfo Nothing = ()
159 seqNewStrictnessInfo (Just ty) = seqStrictSig ty
161 #ifdef OLD_STRICTNESS
162 oldStrictnessFromNew :: StrictSig -> Demand.StrictnessInfo
163 oldStrictnessFromNew sig = mkStrictnessInfo (map oldDemand dmds, isBotRes res_info)
165 (dmds, res_info) = splitStrictSig sig
167 cprInfoFromNewStrictness :: StrictSig -> CprInfo
168 cprInfoFromNewStrictness sig = case strictSigResInfo sig of
172 newStrictnessFromOld :: Name -> Arity -> Demand.StrictnessInfo -> CprInfo -> StrictSig
173 newStrictnessFromOld name arity (Demand.StrictnessInfo ds res) cpr
174 | listLengthCmp ds arity /= GT -- length ds <= arity
175 -- Sometimes the old strictness analyser has more
176 -- demands than the arity justifies
177 = mk_strict_sig name arity $
178 mkTopDmdType (map newDemand ds) (newRes res cpr)
180 newStrictnessFromOld name arity other cpr
181 = -- Either no strictness info, or arity is too small
182 -- In either case we can't say anything useful
183 mk_strict_sig name arity $
184 mkTopDmdType (replicate arity lazyDmd) (newRes False cpr)
186 mk_strict_sig name arity dmd_ty
187 = WARN( arity /= dmdTypeDepth dmd_ty, ppr name <+> (ppr arity $$ ppr dmd_ty) )
190 newRes True _ = BotRes
191 newRes False ReturnsCPR = RetCPR
192 newRes False NoCPRInfo = TopRes
194 newDemand :: Demand.Demand -> NewDemand.Demand
195 newDemand (WwLazy True) = Abs
196 newDemand (WwLazy False) = lazyDmd
197 newDemand WwStrict = evalDmd
198 newDemand (WwUnpack unpk ds) = Eval (Prod (map newDemand ds))
199 newDemand WwPrim = lazyDmd
200 newDemand WwEnum = evalDmd
202 oldDemand :: NewDemand.Demand -> Demand.Demand
203 oldDemand Abs = WwLazy True
204 oldDemand Top = WwLazy False
205 oldDemand Bot = WwStrict
206 oldDemand (Box Bot) = WwStrict
207 oldDemand (Box Abs) = WwLazy False
208 oldDemand (Box (Eval _)) = WwStrict -- Pass box only
209 oldDemand (Defer d) = WwLazy False
210 oldDemand (Eval (Prod ds)) = WwUnpack True (map oldDemand ds)
211 oldDemand (Eval (Poly _)) = WwStrict
212 oldDemand (Call _) = WwStrict
214 #endif /* OLD_STRICTNESS */
218 %************************************************************************
220 \subsection{GlobalIdDetails
222 %************************************************************************
224 This type is here (rather than in Id.lhs) mainly because there's
225 an IdInfo.hi-boot, but no Id.hi-boot, and GlobalIdDetails is imported
226 (recursively) by Var.lhs.
230 = VanillaGlobal -- Imported from elsewhere, a default method Id.
232 | RecordSelId FieldLabel -- The Id for a record selector
233 | DataConId DataCon -- The Id for a data constructor *worker*
234 | DataConWrapId DataCon -- The Id for a data constructor *wrapper*
235 -- [the only reasons we need to know is so that
236 -- a) we can suppress printing a definition in the interface file
237 -- b) when typechecking a pattern we can get from the
238 -- Id back to the data con]
240 | PrimOpId PrimOp -- The Id for a primitive operator
241 | FCallId ForeignCall -- The Id for a foreign call
243 | NotGlobalId -- Used as a convenient extra return value from globalIdDetails
245 notGlobalId = NotGlobalId
247 instance Outputable GlobalIdDetails where
248 ppr NotGlobalId = ptext SLIT("[***NotGlobalId***]")
249 ppr VanillaGlobal = ptext SLIT("[GlobalId]")
250 ppr (DataConId _) = ptext SLIT("[DataCon]")
251 ppr (DataConWrapId _) = ptext SLIT("[DataConWrapper]")
252 ppr (PrimOpId _) = ptext SLIT("[PrimOp]")
253 ppr (FCallId _) = ptext SLIT("[ForeignCall]")
254 ppr (RecordSelId _) = ptext SLIT("[RecSel]")
258 %************************************************************************
260 \subsection{The main IdInfo type}
262 %************************************************************************
264 An @IdInfo@ gives {\em optional} information about an @Id@. If
265 present it never lies, but it may not be present, in which case there
266 is always a conservative assumption which can be made.
268 Two @Id@s may have different info even though they have the same
269 @Unique@ (and are hence the same @Id@); for example, one might lack
270 the properties attached to the other.
272 The @IdInfo@ gives information about the value, or definition, of the
273 @Id@. It does {\em not} contain information about the @Id@'s usage
274 (except for @DemandInfo@? ToDo). (@lbvarInfo@ is also a marginal
280 arityInfo :: !ArityInfo, -- Its arity
281 specInfo :: CoreRules, -- Specialisations of this function which exist
282 tyGenInfo :: TyGenInfo, -- Restrictions on usage-generalisation of this Id
283 #ifdef OLD_STRICTNESS
284 cprInfo :: CprInfo, -- Function always constructs a product result
285 demandInfo :: Demand.Demand, -- Whether or not it is definitely demanded
286 strictnessInfo :: StrictnessInfo, -- Strictness properties
288 workerInfo :: WorkerInfo, -- Pointer to Worker Function
289 unfoldingInfo :: Unfolding, -- Its unfolding
290 cgInfo :: CgInfo, -- Code generator info (arity, CAF info)
291 lbvarInfo :: LBVarInfo, -- Info about a lambda-bound variable
292 inlinePragInfo :: InlinePragInfo, -- Inline pragma
293 occInfo :: OccInfo, -- How it occurs
295 newStrictnessInfo :: Maybe StrictSig, -- Reason for Maybe: the DmdAnal phase needs to
296 -- know whether whether this is the first visit,
297 -- so it can assign botSig. Other customers want
298 -- topSig. So Nothing is good.
299 newDemandInfo :: Demand
302 seqIdInfo :: IdInfo -> ()
303 seqIdInfo (IdInfo {}) = ()
305 megaSeqIdInfo :: IdInfo -> ()
307 = seqRules (specInfo info) `seq`
308 seqTyGenInfo (tyGenInfo info) `seq`
309 seqWorker (workerInfo info) `seq`
311 -- Omitting this improves runtimes a little, presumably because
312 -- some unfoldings are not calculated at all
313 -- seqUnfolding (unfoldingInfo info) `seq`
315 seqDemand (newDemandInfo info) `seq`
316 seqNewStrictnessInfo (newStrictnessInfo info) `seq`
318 #ifdef OLD_STRICTNESS
319 Demand.seqDemand (demandInfo info) `seq`
320 seqStrictnessInfo (strictnessInfo info) `seq`
321 seqCpr (cprInfo info) `seq`
324 -- CgInfo is involved in a loop, so we have to be careful not to seq it
326 -- seqCg (cgInfo info) `seq`
327 seqLBVar (lbvarInfo info) `seq`
328 seqOccInfo (occInfo info)
334 setWorkerInfo info wk = wk `seq` info { workerInfo = wk }
335 setSpecInfo info sp = sp `seq` info { specInfo = sp }
336 setTyGenInfo info tg = tg `seq` info { tyGenInfo = tg }
337 setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr }
338 setOccInfo info oc = oc `seq` info { occInfo = oc }
339 #ifdef OLD_STRICTNESS
340 setStrictnessInfo info st = st `seq` info { strictnessInfo = st }
342 -- Try to avoid spack leaks by seq'ing
344 setUnfoldingInfo info uf
345 | isEvaldUnfolding uf
346 -- If the unfolding is a value, the demand info may
347 -- go pear-shaped, so we nuke it. Example:
349 -- case x of (p,q) -> h p q x
350 -- Here x is certainly demanded. But after we've nuked
351 -- the case, we'll get just
352 -- let x = (a,b) in h a b x
353 -- and now x is not demanded (I'm assuming h is lazy)
354 -- This really happens. The solution here is a bit ad hoc...
355 = info { unfoldingInfo = uf, newDemandInfo = Top }
358 -- We do *not* seq on the unfolding info, For some reason, doing so
359 -- actually increases residency significantly.
360 = info { unfoldingInfo = uf }
362 #ifdef OLD_STRICTNESS
363 setDemandInfo info dd = info { demandInfo = dd }
364 setCprInfo info cp = info { cprInfo = cp }
367 setArityInfo info ar = info { arityInfo = ar }
368 setCgInfo info cg = info { cgInfo = cg }
370 setLBVarInfo info lb = {-lb `seq`-} info { lbvarInfo = lb }
372 setNewDemandInfo info dd = dd `seq` info { newDemandInfo = dd }
373 setNewStrictnessInfo info dd = dd `seq` info { newStrictnessInfo = dd }
378 vanillaIdInfo :: IdInfo
382 arityInfo = unknownArity,
383 #ifdef OLD_STRICTNESS
386 strictnessInfo = NoStrictnessInfo,
388 specInfo = emptyCoreRules,
389 tyGenInfo = noTyGenInfo,
390 workerInfo = NoWorker,
391 unfoldingInfo = noUnfolding,
392 lbvarInfo = NoLBVarInfo,
393 inlinePragInfo = AlwaysActive,
395 newDemandInfo = topDmd,
396 newStrictnessInfo = Nothing
399 noCafNoTyGenIdInfo = vanillaIdInfo `setTyGenInfo` TyGenNever
400 `setCgInfo` CgInfo NoCafRefs
401 -- Used for built-in type Ids in MkId.
402 -- Many built-in things have fixed types, so we shouldn't
403 -- run around generalising them
407 %************************************************************************
409 \subsection[arity-IdInfo]{Arity info about an @Id@}
411 %************************************************************************
413 For locally-defined Ids, the code generator maintains its own notion
414 of their arities; so it should not be asking... (but other things
415 besides the code-generator need arity info!)
418 type ArityInfo = Arity
419 -- A partial application of this Id to up to n-1 value arguments
420 -- does essentially no work. That is not necessarily the
421 -- same as saying that it has n leading lambdas, because coerces
422 -- may get in the way.
424 -- The arity might increase later in the compilation process, if
425 -- an extra lambda floats up to the binding site.
427 unknownArity = 0 :: Arity
429 ppArityInfo 0 = empty
430 ppArityInfo n = hsep [ptext SLIT("Arity"), int n]
433 %************************************************************************
435 \subsection{Inline-pragma information}
437 %************************************************************************
440 type InlinePragInfo = Activation
441 -- Tells when the inlining is active
442 -- When it is active the thing may be inlined, depending on how
445 -- If there was an INLINE pragma, then as a separate matter, the
446 -- RHS will have been made to look small with a CoreSyn Inline Note
450 %************************************************************************
452 \subsection[TyGen-IdInfo]{Type generalisation info about an @Id@}
454 %************************************************************************
456 Certain passes (notably usage inference) may change the type of an
457 identifier, modifying all in-scope uses of that identifier
458 appropriately to maintain type safety.
460 However, some identifiers must not have their types changed in this
461 way, because their types are conjured up in the front end of the
462 compiler rather than being read from the interface file. Default
463 methods, dictionary functions, record selectors, and others are in
464 this category. (see comment at TcClassDcl.tcClassSig).
466 To indicate this property, such identifiers are marked TyGenNever.
468 Furthermore, if the usage inference generates a usage-specialised
469 variant of a function, we must NOT re-infer a fully-generalised type
470 at the next inference. This finer property is indicated by a
471 TyGenUInfo on the identifier.
475 = NoTyGenInfo -- no restriction on type generalisation
477 | TyGenUInfo [Maybe Type] -- restrict generalisation of this Id to
478 -- preserve specified usage annotations
480 | TyGenNever -- never generalise the type of this Id
483 For TyGenUInfo, the list has one entry for each usage annotation on
484 the type of the Id, in left-to-right pre-order (annotations come
485 before the type they annotate). Nothing means no restriction; Just
486 usOnce or Just usMany forces that annotation to that value. Other
487 usage annotations are illegal.
490 seqTyGenInfo :: TyGenInfo -> ()
491 seqTyGenInfo NoTyGenInfo = ()
492 seqTyGenInfo (TyGenUInfo us) = seqList us ()
493 seqTyGenInfo TyGenNever = ()
495 noTyGenInfo :: TyGenInfo
496 noTyGenInfo = NoTyGenInfo
498 isNoTyGenInfo :: TyGenInfo -> Bool
499 isNoTyGenInfo NoTyGenInfo = True
500 isNoTyGenInfo _ = False
502 -- NB: There's probably no need to write this information out to the interface file.
503 -- Why? Simply because imported identifiers never get their types re-inferred.
504 -- But it's definitely nice to see in dumps, it for debugging purposes.
506 ppTyGenInfo :: TyGenInfo -> SDoc
507 ppTyGenInfo NoTyGenInfo = empty
508 ppTyGenInfo (TyGenUInfo us) = ptext SLIT("__G") <+> text (tyGenInfoString us)
509 ppTyGenInfo TyGenNever = ptext SLIT("__G N")
511 tyGenInfoString us = map go us
512 where go Nothing = 'x' -- for legibility, choose
513 go (Just u) | u `eqUsage` usOnce = '1' -- chars with identity
514 | u `eqUsage` usMany = 'M' -- Z-encoding.
515 go other = pprPanic "IdInfo.tyGenInfoString: unexpected annotation" (ppr other)
517 instance Outputable TyGenInfo where
520 instance Show TyGenInfo where
521 showsPrec p c = showsPrecSDoc p (ppr c)
525 %************************************************************************
527 \subsection[worker-IdInfo]{Worker info about an @Id@}
529 %************************************************************************
531 If this Id has a worker then we store a reference to it. Worker
532 functions are generated by the worker/wrapper pass. This uses
533 information from strictness analysis.
535 There might not be a worker, even for a strict function, because:
536 (a) the function might be small enough to inline, so no need
538 (b) the strictness info might be "SSS" or something, so no w/w split.
540 Sometimes the arity of a wrapper changes from the original arity from
541 which it was generated, so we always emit the "original" arity into
542 the interface file, as part of the worker info.
544 How can this happen? Sometimes we get
545 f = coerce t (\x y -> $wf x y)
546 at the moment of w/w split; but the eta reducer turns it into
548 which is perfectly fine except that the exposed arity so far as
549 the code generator is concerned (zero) differs from the arity
550 when we did the split (2).
552 All this arises because we use 'arity' to mean "exactly how many
553 top level lambdas are there" in interface files; but during the
554 compilation of this module it means "how many things can I apply
559 data WorkerInfo = NoWorker
561 -- The Arity is the arity of the *wrapper* at the moment of the
562 -- w/w split. See comments in MkIface.ifaceId, with the 'Worker' code.
564 seqWorker :: WorkerInfo -> ()
565 seqWorker (HasWorker id a) = id `seq` a `seq` ()
566 seqWorker NoWorker = ()
568 ppWorkerInfo NoWorker = empty
569 ppWorkerInfo (HasWorker wk_id _) = ptext SLIT("__P") <+> ppr wk_id
571 workerExists :: WorkerInfo -> Bool
572 workerExists NoWorker = False
573 workerExists (HasWorker _ _) = True
575 workerId :: WorkerInfo -> Id
576 workerId (HasWorker id _) = id
578 wrapperArity :: WorkerInfo -> Arity
579 wrapperArity (HasWorker _ a) = a
583 %************************************************************************
585 \subsection[CG-IdInfo]{Code generator-related information}
587 %************************************************************************
589 CgInfo encapsulates calling-convention information produced by the code
590 generator. It is pasted into the IdInfo of each emitted Id by CoreTidy,
591 but only as a thunk --- the information is only actually produced further
592 downstream, by the code generator.
595 #ifndef OLD_STRICTNESS
596 newtype CgInfo = CgInfo CafInfo -- We are back to only having CafRefs in CgInfo
597 noCgInfo = panic "NoCgInfo!"
599 data CgInfo = CgInfo CafInfo
600 | NoCgInfo -- In debug mode we don't want a black hole here
602 -- noCgInfo is used for local Ids, which shouldn't need any CgInfo
606 cgCafInfo (CgInfo caf_info) = caf_info
608 setCafInfo info caf_info = info `setCgInfo` CgInfo caf_info
610 seqCg c = c `seq` () -- fields are strict anyhow
612 vanillaCgInfo = CgInfo MayHaveCafRefs -- Definitely safe
614 -- CafInfo is used to build Static Reference Tables (see simplStg/SRT.lhs).
617 = MayHaveCafRefs -- either:
618 -- (1) A function or static constructor
619 -- that refers to one or more CAFs,
620 -- (2) A real live CAF
622 | NoCafRefs -- A function or static constructor
623 -- that refers to no CAFs.
625 mayHaveCafRefs MayHaveCafRefs = True
626 mayHaveCafRefs _ = False
628 seqCaf c = c `seq` ()
630 pprCgInfo (CgInfo caf_info) = ppCafInfo caf_info
633 ppArity n = hsep [ptext SLIT("__A"), int n]
635 ppCafInfo NoCafRefs = ptext SLIT("__C")
636 ppCafInfo MayHaveCafRefs = empty
640 type CgInfoEnv = NameEnv CgInfo
642 lookupCgInfo :: NameEnv CgInfo -> Name -> CgInfo
643 lookupCgInfo env n = case lookupNameEnv env n of
645 Nothing -> pprTrace "Urk! Not in CgInfo env" (ppr n) vanillaCgInfo
649 %************************************************************************
651 \subsection[cpr-IdInfo]{Constructed Product Result info about an @Id@}
653 %************************************************************************
655 If the @Id@ is a function then it may have CPR info. A CPR analysis
656 phase detects whether:
660 The function's return value has a product type, i.e. an algebraic type
661 with a single constructor. Examples of such types are tuples and boxed
664 The function always 'constructs' the value that it is returning. It
665 must do this on every path through, and it's OK if it calls another
666 function which constructs the result.
669 If this is the case then we store a template which tells us the
670 function has the CPR property and which components of the result are
674 #ifdef OLD_STRICTNESS
677 | ReturnsCPR -- Yes, this function returns a constructed product
678 -- Implicitly, this means "after the function has been applied
679 -- to all its arguments", so the worker/wrapper builder in
680 -- WwLib.mkWWcpr checks that that it is indeed saturated before
681 -- making use of the CPR info
683 -- We used to keep nested info about sub-components, but
684 -- we never used it so I threw it away
686 seqCpr :: CprInfo -> ()
687 seqCpr ReturnsCPR = ()
688 seqCpr NoCPRInfo = ()
690 noCprInfo = NoCPRInfo
692 ppCprInfo NoCPRInfo = empty
693 ppCprInfo ReturnsCPR = ptext SLIT("__M")
695 instance Outputable CprInfo where
698 instance Show CprInfo where
699 showsPrec p c = showsPrecSDoc p (ppr c)
704 %************************************************************************
706 \subsection[lbvar-IdInfo]{Lambda-bound var info about an @Id@}
708 %************************************************************************
710 If the @Id@ is a lambda-bound variable then it may have lambda-bound
711 var info. The usage analysis (UsageSP) detects whether the lambda
712 binding this var is a ``one-shot'' lambda; that is, whether it is
713 applied at most once.
715 This information may be useful in optimisation, as computations may
716 safely be floated inside such a lambda without risk of duplicating
723 | LBVarInfo Type -- The lambda that binds this Id has this usage
724 -- annotation (i.e., if ==usOnce, then the
725 -- lambda is applied at most once).
726 -- The annotation's kind must be `$'
727 -- HACK ALERT! placing this info here is a short-term hack,
728 -- but it minimises changes to the rest of the compiler.
729 -- Hack agreed by SLPJ/KSW 1999-04.
731 seqLBVar l = l `seq` ()
735 hasNoLBVarInfo NoLBVarInfo = True
736 hasNoLBVarInfo other = False
738 noLBVarInfo = NoLBVarInfo
740 -- not safe to print or parse LBVarInfo because it is not really a
741 -- property of the definition, but a property of the context.
742 pprLBVarInfo NoLBVarInfo = empty
743 pprLBVarInfo (LBVarInfo u) | u `eqUsage` usOnce
744 = ptext SLIT("OneShot")
748 instance Outputable LBVarInfo where
751 instance Show LBVarInfo where
752 showsPrec p c = showsPrecSDoc p (ppr c)
756 %************************************************************************
758 \subsection{Bulk operations on IdInfo}
760 %************************************************************************
762 @zapLamInfo@ is used for lambda binders that turn out to to be
763 part of an unsaturated lambda
766 zapLamInfo :: IdInfo -> Maybe IdInfo
767 zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand})
768 | is_safe_occ && not (isStrictDmd demand)
771 = Just (info {occInfo = safe_occ,
772 newDemandInfo = Top})
774 -- The "unsafe" occ info is the ones that say I'm not in a lambda
775 -- because that might not be true for an unsaturated lambda
776 is_safe_occ = case occ of
777 OneOcc in_lam once -> in_lam
780 safe_occ = case occ of
781 OneOcc _ once -> OneOcc insideLam once
786 zapDemandInfo :: IdInfo -> Maybe IdInfo
787 zapDemandInfo info@(IdInfo {newDemandInfo = demand})
788 | not (isStrictDmd demand) = Nothing
789 | otherwise = Just (info {newDemandInfo = Top})
793 copyIdInfo is used when shorting out a top-level binding
796 where f is exported. We are going to swizzle it around to
800 BUT (a) we must be careful about messing up rules
801 (b) we must ensure f's IdInfo ends up right
803 (a) Messing up the rules
805 The example that went bad on me was this one:
807 iterate :: (a -> a) -> a -> [a]
808 iterate = iterateList
810 iterateFB c f x = x `c` iterateFB c f (f x)
811 iterateList f x = x : iterateList f (f x)
814 "iterate" forall f x. iterate f x = build (\c _n -> iterateFB c f x)
815 "iterateFB" iterateFB (:) = iterateList
818 This got shorted out to:
820 iterateList :: (a -> a) -> a -> [a]
821 iterateList = iterate
823 iterateFB c f x = x `c` iterateFB c f (f x)
824 iterate f x = x : iterate f (f x)
827 "iterate" forall f x. iterate f x = build (\c _n -> iterateFB c f x)
828 "iterateFB" iterateFB (:) = iterate
831 And now we get an infinite loop in the rule system
832 iterate f x -> build (\cn -> iterateFB c f x)
836 Tiresome solution: don't do shorting out if f has rewrite rules.
837 Hence shortableIdInfo.
839 (b) Keeping the IdInfo right
840 ~~~~~~~~~~~~~~~~~~~~~~~~
841 We want to move strictness/worker info from f_local to f, but keep the rest.
845 shortableIdInfo :: IdInfo -> Bool
846 shortableIdInfo info = isEmptyCoreRules (specInfo info)
848 copyIdInfo :: IdInfo -- f_local
849 -> IdInfo -- f (the exported one)
850 -> IdInfo -- New info for f
851 copyIdInfo f_local f = f { newStrictnessInfo = newStrictnessInfo f_local,
852 #ifdef OLD_STRICTNESS
853 strictnessInfo = strictnessInfo f_local,
854 cprInfo = cprInfo f_local,
856 workerInfo = workerInfo f_local