compiler/basicTypes/IdInfo.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
   3 %
   4 \section[IdInfo]{@IdInfos@: Non-essential information about @Ids@}
   5
   6 (And a pretty good illustration of quite a few things wrong with
   7 Haskell. [WDP 94/11])
   8
   9 \begin{code}
  10 module IdInfo (
  11         GlobalIdDetails(..), notGlobalId,       -- Not abstract
  12
  13         IdInfo,         -- Abstract
  14         vanillaIdInfo, noCafIdInfo,
  15         seqIdInfo, megaSeqIdInfo,
  16
  17         -- Zapping
  18         zapLamInfo, zapDemandInfo,
  19
  20         -- Arity
  21         ArityInfo,
  22         unknownArity,
  23         arityInfo, setArityInfo, ppArityInfo,
  24
  25         -- New demand and strictness info
  26         newStrictnessInfo, setNewStrictnessInfo,
  27         newDemandInfo, setNewDemandInfo, pprNewStrictness,
  28         setAllStrictnessInfo,
  29
  30 #ifdef OLD_STRICTNESS
  31         -- Strictness; imported from Demand
  32         StrictnessInfo(..),
  33         mkStrictnessInfo, noStrictnessInfo,
  34         ppStrictnessInfo,isBottomingStrictness,
  35 #endif
  36
  37         -- Worker
  38         WorkerInfo(..), workerExists, wrapperArity, workerId,
  39         workerInfo, setWorkerInfo, ppWorkerInfo,
  40
  41         -- Unfolding
  42         unfoldingInfo, setUnfoldingInfo, setUnfoldingInfoLazily,
  43
  44 #ifdef OLD_STRICTNESS
  45         -- Old DemandInfo and StrictnessInfo
  46         demandInfo, setDemandInfo,
  47         strictnessInfo, setStrictnessInfo,
  48         cprInfoFromNewStrictness,
  49         oldStrictnessFromNew, newStrictnessFromOld,
  50         oldDemand, newDemand,
  51
  52         -- Constructed Product Result Info
  53         CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo,
  54 #endif
  55
  56         -- Inline prags
  57         InlinePragInfo,
  58         inlinePragInfo, setInlinePragInfo,
  59
  60         -- Occurrence info
  61         OccInfo(..), isFragileOcc, isDeadOcc, isLoopBreaker,
  62         InsideLam, OneBranch, insideLam, notInsideLam, oneBranch, notOneBranch,
  63         occInfo, setOccInfo,
  64
  65         -- Specialisation
  66         SpecInfo(..), specInfo, setSpecInfo, isEmptySpecInfo,
  67         specInfoFreeVars, specInfoRules, seqSpecInfo,
  68
  69         -- CAF info
  70         CafInfo(..), cafInfo, ppCafInfo, setCafInfo, mayHaveCafRefs,
  71
  72         -- Lambda-bound variable info
  73         LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo, hasNoLBVarInfo
  74     ) where
  75
  76 #include "HsVersions.h"
  77
  78
  79 import CoreSyn
  80 import Class            ( Class )
  81 import PrimOp           ( PrimOp )
  82 import Var              ( Id )
  83 import VarSet           ( VarSet, emptyVarSet, seqVarSet )
  84 import BasicTypes       ( OccInfo(..), isFragileOcc, isDeadOcc, seqOccInfo, isLoopBreaker,
  85                           InsideLam, insideLam, notInsideLam,
  86                           OneBranch, oneBranch, notOneBranch,
  87                           Arity,
  88                           Activation(..)
  89                         )
  90 import DataCon          ( DataCon )
  91 import TyCon            ( TyCon, FieldLabel )
  92 import ForeignCall      ( ForeignCall )
  93 import NewDemand
  94 import Outputable
  95 import Maybe            ( isJust )
  96
  97 #ifdef OLD_STRICTNESS
  98 import Name             ( Name )
  99 import Demand           hiding( Demand, seqDemand )
 100 import qualified Demand
 101 import Util             ( listLengthCmp )
 102 import List             ( replicate )
 103 #endif
 104
 105 -- infixl so you can say (id `set` a `set` b)
 106 infixl  1 `setSpecInfo`,
 107           `setArityInfo`,
 108           `setInlinePragInfo`,
 109           `setUnfoldingInfo`,
 110           `setWorkerInfo`,
 111           `setLBVarInfo`,
 112           `setOccInfo`,
 113           `setCafInfo`,
 114           `setNewStrictnessInfo`,
 115           `setAllStrictnessInfo`,
 116           `setNewDemandInfo`
 117 #ifdef OLD_STRICTNESS
 118           , `setCprInfo`
 119           , `setDemandInfo`
 120           , `setStrictnessInfo`
 121 #endif
 122 \end{code}
 123
 124 %************************************************************************
 125 %*                                                                      *
 126 \subsection{New strictness info}
 127 %*                                                                      *
 128 %************************************************************************
 129
 130 To be removed later
 131
 132 \begin{code}
 133 -- setAllStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo
 134 -- Set old and new strictness info
 135 setAllStrictnessInfo info Nothing
 136   = info { newStrictnessInfo = Nothing
 137 #ifdef OLD_STRICTNESS
 138          , strictnessInfo = NoStrictnessInfo
 139          , cprInfo = NoCPRInfo
 140 #endif
 141          }
 142
 143 setAllStrictnessInfo info (Just sig)
 144   = info { newStrictnessInfo = Just sig
 145 #ifdef OLD_STRICTNESS
 146          , strictnessInfo = oldStrictnessFromNew sig
 147          , cprInfo = cprInfoFromNewStrictness sig
 148 #endif
 149          }
 150
 151 seqNewStrictnessInfo Nothing = ()
 152 seqNewStrictnessInfo (Just ty) = seqStrictSig ty
 153
 154 pprNewStrictness Nothing = empty
 155 pprNewStrictness (Just sig) = ftext FSLIT("Str:") <+> ppr sig
 156
 157 #ifdef OLD_STRICTNESS
 158 oldStrictnessFromNew :: StrictSig -> Demand.StrictnessInfo
 159 oldStrictnessFromNew sig = mkStrictnessInfo (map oldDemand dmds, isBotRes res_info)
 160                          where
 161                            (dmds, res_info) = splitStrictSig sig
 162
 163 cprInfoFromNewStrictness :: StrictSig -> CprInfo
 164 cprInfoFromNewStrictness sig = case strictSigResInfo sig of
 165                                   RetCPR -> ReturnsCPR
 166                                   other  -> NoCPRInfo
 167
 168 newStrictnessFromOld :: Name -> Arity -> Demand.StrictnessInfo -> CprInfo -> StrictSig
 169 newStrictnessFromOld name arity (Demand.StrictnessInfo ds res) cpr
 170   | listLengthCmp ds arity /= GT -- length ds <= arity
 171         -- Sometimes the old strictness analyser has more
 172         -- demands than the arity justifies
 173   = mk_strict_sig name arity $
 174     mkTopDmdType (map newDemand ds) (newRes res cpr)
 175
 176 newStrictnessFromOld name arity other cpr
 177   =     -- Either no strictness info, or arity is too small
 178         -- In either case we can't say anything useful
 179     mk_strict_sig name arity $
 180     mkTopDmdType (replicate arity lazyDmd) (newRes False cpr)
 181
 182 mk_strict_sig name arity dmd_ty
 183   = WARN( arity /= dmdTypeDepth dmd_ty, ppr name <+> (ppr arity $$ ppr dmd_ty) )
 184     mkStrictSig dmd_ty
 185
 186 newRes True  _          = BotRes
 187 newRes False ReturnsCPR = retCPR
 188 newRes False NoCPRInfo  = TopRes
 189
 190 newDemand :: Demand.Demand -> NewDemand.Demand
 191 newDemand (WwLazy True)      = Abs
 192 newDemand (WwLazy False)     = lazyDmd
 193 newDemand WwStrict           = evalDmd
 194 newDemand (WwUnpack unpk ds) = Eval (Prod (map newDemand ds))
 195 newDemand WwPrim             = lazyDmd
 196 newDemand WwEnum             = evalDmd
 197
 198 oldDemand :: NewDemand.Demand -> Demand.Demand
 199 oldDemand Abs              = WwLazy True
 200 oldDemand Top              = WwLazy False
 201 oldDemand Bot              = WwStrict
 202 oldDemand (Box Bot)        = WwStrict
 203 oldDemand (Box Abs)        = WwLazy False
 204 oldDemand (Box (Eval _))   = WwStrict   -- Pass box only
 205 oldDemand (Defer d)        = WwLazy False
 206 oldDemand (Eval (Prod ds)) = WwUnpack True (map oldDemand ds)
 207 oldDemand (Eval (Poly _))  = WwStrict
 208 oldDemand (Call _)         = WwStrict
 209
 210 #endif /* OLD_STRICTNESS */
 211 \end{code}
 212
 213
 214 \begin{code}
 215 seqNewDemandInfo Nothing    = ()
 216 seqNewDemandInfo (Just dmd) = seqDemand dmd
 217 \end{code}
 218
 219
 220 %************************************************************************
 221 %*                                                                      *
 222 \subsection{GlobalIdDetails
 223 %*                                                                      *
 224 %************************************************************************
 225
 226 This type is here (rather than in Id.lhs) mainly because there's
 227 an IdInfo.hi-boot, but no Id.hi-boot, and GlobalIdDetails is imported
 228 (recursively) by Var.lhs.
 229
 230 \begin{code}
 231 data GlobalIdDetails
 232   = VanillaGlobal               -- Imported from elsewhere, a default method Id.
 233
 234   | RecordSelId                 -- The Id for a record selector
 235     { sel_tycon   :: TyCon
 236     , sel_label   :: FieldLabel
 237     , sel_naughty :: Bool       -- True <=> naughty
 238     }                           -- See Note [Naughty record selectors]
 239                                 -- with MkId.mkRecordSelectorId
 240
 241   | DataConWorkId DataCon       -- The Id for a data constructor *worker*
 242   | DataConWrapId DataCon       -- The Id for a data constructor *wrapper*
 243                                 -- [the only reasons we need to know is so that
 244                                 --  a) to support isImplicitId
 245                                 --  b) when desugaring a RecordCon we can get
 246                                 --     from the Id back to the data con]
 247
 248   | ClassOpId Class             -- An operation of a class
 249
 250   | PrimOpId PrimOp             -- The Id for a primitive operator
 251   | FCallId ForeignCall         -- The Id for a foreign call
 252
 253   | NotGlobalId                 -- Used as a convenient extra return value from globalIdDetails
 254
 255 notGlobalId = NotGlobalId
 256
 257 instance Outputable GlobalIdDetails where
 258     ppr NotGlobalId       = ptext SLIT("[***NotGlobalId***]")
 259     ppr VanillaGlobal     = ptext SLIT("[GlobalId]")
 260     ppr (DataConWorkId _) = ptext SLIT("[DataCon]")
 261     ppr (DataConWrapId _) = ptext SLIT("[DataConWrapper]")
 262     ppr (ClassOpId _)     = ptext SLIT("[ClassOp]")
 263     ppr (PrimOpId _)      = ptext SLIT("[PrimOp]")
 264     ppr (FCallId _)       = ptext SLIT("[ForeignCall]")
 265     ppr (RecordSelId {})  = ptext SLIT("[RecSel]")
 266 \end{code}
 267
 268
 269 %************************************************************************
 270 %*                                                                      *
 271 \subsection{The main IdInfo type}
 272 %*                                                                      *
 273 %************************************************************************
 274
 275 An @IdInfo@ gives {\em optional} information about an @Id@.  If
 276 present it never lies, but it may not be present, in which case there
 277 is always a conservative assumption which can be made.
 278
 279 Two @Id@s may have different info even though they have the same
 280 @Unique@ (and are hence the same @Id@); for example, one might lack
 281 the properties attached to the other.
 282
 283 The @IdInfo@ gives information about the value, or definition, of the
 284 @Id@.  It does {\em not} contain information about the @Id@'s usage
 285 (except for @DemandInfo@? ToDo). (@lbvarInfo@ is also a marginal
 286 case.  KSW 1999-04).
 287
 288 \begin{code}
 289 data IdInfo
 290   = IdInfo {
 291         arityInfo       :: !ArityInfo,          -- Its arity
 292         specInfo        :: SpecInfo,            -- Specialisations of this function which exist
 293 #ifdef OLD_STRICTNESS
 294         cprInfo         :: CprInfo,             -- Function always constructs a product result
 295         demandInfo      :: Demand.Demand,       -- Whether or not it is definitely demanded
 296         strictnessInfo  :: StrictnessInfo,      -- Strictness properties
 297 #endif
 298         workerInfo      :: WorkerInfo,          -- Pointer to Worker Function
 299                                                 -- Within one module this is irrelevant; the
 300                                                 -- inlining of a worker is handled via the Unfolding
 301                                                 -- WorkerInfo is used *only* to indicate the form of
 302                                                 -- the RHS, so that interface files don't actually
 303                                                 -- need to contain the RHS; it can be derived from
 304                                                 -- the strictness info
 305
 306         unfoldingInfo   :: Unfolding,           -- Its unfolding
 307         cafInfo         :: CafInfo,             -- CAF info
 308         lbvarInfo       :: LBVarInfo,           -- Info about a lambda-bound variable
 309         inlinePragInfo  :: InlinePragInfo,      -- Inline pragma
 310         occInfo         :: OccInfo,             -- How it occurs
 311
 312         newStrictnessInfo :: Maybe StrictSig,   -- Reason for Maybe: the DmdAnal phase needs to
 313                                                 -- know whether whether this is the first visit,
 314                                                 -- so it can assign botSig.  Other customers want
 315                                                 -- topSig.  So Nothing is good.
 316
 317         newDemandInfo     :: Maybe Demand       -- Similarly we want to know if there's no
 318                                                 -- known demand yet, for when we are looking for
 319                                                 -- CPR info
 320     }
 321
 322 seqIdInfo :: IdInfo -> ()
 323 seqIdInfo (IdInfo {}) = ()
 324
 325 megaSeqIdInfo :: IdInfo -> ()
 326 megaSeqIdInfo info
 327   = seqSpecInfo (specInfo info)                 `seq`
 328     seqWorker (workerInfo info)                 `seq`
 329
 330 -- Omitting this improves runtimes a little, presumably because
 331 -- some unfoldings are not calculated at all
 332 --    seqUnfolding (unfoldingInfo info)         `seq`
 333
 334     seqNewDemandInfo (newDemandInfo info)       `seq`
 335     seqNewStrictnessInfo (newStrictnessInfo info) `seq`
 336
 337 #ifdef OLD_STRICTNESS
 338     Demand.seqDemand (demandInfo info)          `seq`
 339     seqStrictnessInfo (strictnessInfo info)     `seq`
 340     seqCpr (cprInfo info)                       `seq`
 341 #endif
 342
 343     seqCaf (cafInfo info)                       `seq`
 344     seqLBVar (lbvarInfo info)                   `seq`
 345     seqOccInfo (occInfo info)
 346 \end{code}
 347
 348 Setters
 349
 350 \begin{code}
 351 setWorkerInfo     info wk = wk `seq` info { workerInfo = wk }
 352 setSpecInfo       info sp = sp `seq` info { specInfo = sp }
 353 setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr }
 354 setOccInfo        info oc = oc `seq` info { occInfo = oc }
 355 #ifdef OLD_STRICTNESS
 356 setStrictnessInfo info st = st `seq` info { strictnessInfo = st }
 357 #endif
 358         -- Try to avoid spack leaks by seq'ing
 359
 360 setUnfoldingInfoLazily info uf  -- Lazy variant to avoid looking at the
 361   =                             -- unfolding of an imported Id unless necessary
 362     info { unfoldingInfo = uf } -- (In this case the demand-zapping is redundant.)
 363
 364 setUnfoldingInfo info uf
 365         -- We do *not* seq on the unfolding info, For some reason, doing so
 366         -- actually increases residency significantly.
 367   = info { unfoldingInfo = uf }
 368
 369 #ifdef OLD_STRICTNESS
 370 setDemandInfo     info dd = info { demandInfo = dd }
 371 setCprInfo        info cp = info { cprInfo = cp }
 372 #endif
 373
 374 setArityInfo      info ar  = info { arityInfo = ar  }
 375 setCafInfo        info caf = info { cafInfo = caf }
 376
 377 setLBVarInfo      info lb = {-lb `seq`-} info { lbvarInfo = lb }
 378
 379 setNewDemandInfo     info dd = dd `seq` info { newDemandInfo = dd }
 380 setNewStrictnessInfo info dd = dd `seq` info { newStrictnessInfo = dd }
 381 \end{code}
 382
 383
 384 \begin{code}
 385 vanillaIdInfo :: IdInfo
 386 vanillaIdInfo
 387   = IdInfo {
 388             cafInfo             = vanillaCafInfo,
 389             arityInfo           = unknownArity,
 390 #ifdef OLD_STRICTNESS
 391             cprInfo             = NoCPRInfo,
 392             demandInfo          = wwLazy,
 393             strictnessInfo      = NoStrictnessInfo,
 394 #endif
 395             specInfo            = emptySpecInfo,
 396             workerInfo          = NoWorker,
 397             unfoldingInfo       = noUnfolding,
 398             lbvarInfo           = NoLBVarInfo,
 399             inlinePragInfo      = AlwaysActive,
 400             occInfo             = NoOccInfo,
 401             newDemandInfo       = Nothing,
 402             newStrictnessInfo   = Nothing
 403            }
 404
 405 noCafIdInfo  = vanillaIdInfo `setCafInfo`    NoCafRefs
 406         -- Used for built-in type Ids in MkId.
 407 \end{code}
 408
 409
 410 %************************************************************************
 411 %*                                                                      *
 412 \subsection[arity-IdInfo]{Arity info about an @Id@}
 413 %*                                                                      *
 414 %************************************************************************
 415
 416 For locally-defined Ids, the code generator maintains its own notion
 417 of their arities; so it should not be asking...  (but other things
 418 besides the code-generator need arity info!)
 419
 420 \begin{code}
 421 type ArityInfo = Arity
 422         -- A partial application of this Id to up to n-1 value arguments
 423         -- does essentially no work.  That is not necessarily the
 424         -- same as saying that it has n leading lambdas, because coerces
 425         -- may get in the way.
 426
 427         -- The arity might increase later in the compilation process, if
 428         -- an extra lambda floats up to the binding site.
 429
 430 unknownArity = 0 :: Arity
 431
 432 ppArityInfo 0 = empty
 433 ppArityInfo n = hsep [ptext SLIT("Arity"), int n]
 434 \end{code}
 435
 436 %************************************************************************
 437 %*                                                                      *
 438 \subsection{Inline-pragma information}
 439 %*                                                                      *
 440 %************************************************************************
 441
 442 \begin{code}
 443 type InlinePragInfo = Activation
 444         -- Tells when the inlining is active
 445         -- When it is active the thing may be inlined, depending on how
 446         -- big it is.
 447         --
 448         -- If there was an INLINE pragma, then as a separate matter, the
 449         -- RHS will have been made to look small with a CoreSyn Inline Note
 450
 451         -- The default InlinePragInfo is AlwaysActive, so the info serves
 452         -- entirely as a way to inhibit inlining until we want it
 453 \end{code}
 454
 455
 456 %************************************************************************
 457 %*                                                                      *
 458         SpecInfo
 459 %*                                                                      *
 460 %************************************************************************
 461
 462 \begin{code}
 463 -- CoreRules is used only in an idSpecialisation (move to IdInfo?)
 464 data SpecInfo
 465   = SpecInfo [CoreRule] VarSet  -- Locally-defined free vars of RHSs
 466
 467 emptySpecInfo :: SpecInfo
 468 emptySpecInfo = SpecInfo [] emptyVarSet
 469
 470 isEmptySpecInfo :: SpecInfo -> Bool
 471 isEmptySpecInfo (SpecInfo rs _) = null rs
 472
 473 specInfoFreeVars :: SpecInfo -> VarSet
 474 specInfoFreeVars (SpecInfo _ fvs) = fvs
 475
 476 specInfoRules :: SpecInfo -> [CoreRule]
 477 specInfoRules (SpecInfo rules _) = rules
 478
 479 seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs
 480 \end{code}
 481
 482
 483 %************************************************************************
 484 %*                                                                      *
 485 \subsection[worker-IdInfo]{Worker info about an @Id@}
 486 %*                                                                      *
 487 %************************************************************************
 488
 489 If this Id has a worker then we store a reference to it. Worker
 490 functions are generated by the worker/wrapper pass.  This uses
 491 information from strictness analysis.
 492
 493 There might not be a worker, even for a strict function, because:
 494 (a) the function might be small enough to inline, so no need
 495     for w/w split
 496 (b) the strictness info might be "SSS" or something, so no w/w split.
 497
 498 Sometimes the arity of a wrapper changes from the original arity from
 499 which it was generated, so we always emit the "original" arity into
 500 the interface file, as part of the worker info.
 501
 502 How can this happen?  Sometimes we get
 503         f = coerce t (\x y -> $wf x y)
 504 at the moment of w/w split; but the eta reducer turns it into
 505         f = coerce t $wf
 506 which is perfectly fine except that the exposed arity so far as
 507 the code generator is concerned (zero) differs from the arity
 508 when we did the split (2).
 509
 510 All this arises because we use 'arity' to mean "exactly how many
 511 top level lambdas are there" in interface files; but during the
 512 compilation of this module it means "how many things can I apply
 513 this to".
 514
 515 \begin{code}
 516
 517 data WorkerInfo = NoWorker
 518                 | HasWorker Id Arity
 519         -- The Arity is the arity of the *wrapper* at the moment of the
 520         -- w/w split.  See notes above.
 521
 522 seqWorker :: WorkerInfo -> ()
 523 seqWorker (HasWorker id a) = id `seq` a `seq` ()
 524 seqWorker NoWorker         = ()
 525
 526 ppWorkerInfo NoWorker            = empty
 527 ppWorkerInfo (HasWorker wk_id _) = ptext SLIT("Worker") <+> ppr wk_id
 528
 529 workerExists :: WorkerInfo -> Bool
 530 workerExists NoWorker        = False
 531 workerExists (HasWorker _ _) = True
 532
 533 workerId :: WorkerInfo -> Id
 534 workerId (HasWorker id _) = id
 535
 536 wrapperArity :: WorkerInfo -> Arity
 537 wrapperArity (HasWorker _ a) = a
 538 \end{code}
 539
 540
 541 %************************************************************************
 542 %*                                                                      *
 543 \subsection[CG-IdInfo]{Code generator-related information}
 544 %*                                                                      *
 545 %************************************************************************
 546
 547 \begin{code}
 548 -- CafInfo is used to build Static Reference Tables (see simplStg/SRT.lhs).
 549
 550 data CafInfo
 551         = MayHaveCafRefs                -- either:
 552                                         -- (1) A function or static constructor
 553                                         --     that refers to one or more CAFs,
 554                                         -- (2) A real live CAF
 555
 556         | NoCafRefs                     -- A function or static constructor
 557                                         -- that refers to no CAFs.
 558
 559 vanillaCafInfo = MayHaveCafRefs         -- Definitely safe
 560
 561 mayHaveCafRefs  MayHaveCafRefs = True
 562 mayHaveCafRefs _               = False
 563
 564 seqCaf c = c `seq` ()
 565
 566 ppCafInfo NoCafRefs = ptext SLIT("NoCafRefs")
 567 ppCafInfo MayHaveCafRefs = empty
 568 \end{code}
 569
 570 %************************************************************************
 571 %*                                                                      *
 572 \subsection[cpr-IdInfo]{Constructed Product Result info about an @Id@}
 573 %*                                                                      *
 574 %************************************************************************
 575
 576 If the @Id@ is a function then it may have CPR info. A CPR analysis
 577 phase detects whether:
 578
 579 \begin{enumerate}
 580 \item
 581 The function's return value has a product type, i.e. an algebraic  type
 582 with a single constructor. Examples of such types are tuples and boxed
 583 primitive values.
 584 \item
 585 The function always 'constructs' the value that it is returning.  It
 586 must do this on every path through,  and it's OK if it calls another
 587 function which constructs the result.
 588 \end{enumerate}
 589
 590 If this is the case then we store a template which tells us the
 591 function has the CPR property and which components of the result are
 592 also CPRs.
 593
 594 \begin{code}
 595 #ifdef OLD_STRICTNESS
 596 data CprInfo
 597   = NoCPRInfo
 598   | ReturnsCPR  -- Yes, this function returns a constructed product
 599                 -- Implicitly, this means "after the function has been applied
 600                 -- to all its arguments", so the worker/wrapper builder in
 601                 -- WwLib.mkWWcpr checks that that it is indeed saturated before
 602                 -- making use of the CPR info
 603
 604         -- We used to keep nested info about sub-components, but
 605         -- we never used it so I threw it away
 606
 607 seqCpr :: CprInfo -> ()
 608 seqCpr ReturnsCPR = ()
 609 seqCpr NoCPRInfo  = ()
 610
 611 noCprInfo       = NoCPRInfo
 612
 613 ppCprInfo NoCPRInfo  = empty
 614 ppCprInfo ReturnsCPR = ptext SLIT("__M")
 615
 616 instance Outputable CprInfo where
 617     ppr = ppCprInfo
 618
 619 instance Show CprInfo where
 620     showsPrec p c = showsPrecSDoc p (ppr c)
 621 #endif
 622 \end{code}
 623
 624
 625 %************************************************************************
 626 %*                                                                      *
 627 \subsection[lbvar-IdInfo]{Lambda-bound var info about an @Id@}
 628 %*                                                                      *
 629 %************************************************************************
 630
 631 If the @Id@ is a lambda-bound variable then it may have lambda-bound
 632 var info.  Sometimes we know whether the lambda binding this var is a
 633 ``one-shot'' lambda; that is, whether it is applied at most once.
 634
 635 This information may be useful in optimisation, as computations may
 636 safely be floated inside such a lambda without risk of duplicating
 637 work.
 638
 639 \begin{code}
 640 data LBVarInfo = NoLBVarInfo
 641                | IsOneShotLambda        -- The lambda is applied at most once).
 642
 643 seqLBVar l = l `seq` ()
 644 \end{code}
 645
 646 \begin{code}
 647 hasNoLBVarInfo NoLBVarInfo     = True
 648 hasNoLBVarInfo IsOneShotLambda = False
 649
 650 noLBVarInfo = NoLBVarInfo
 651
 652 pprLBVarInfo NoLBVarInfo     = empty
 653 pprLBVarInfo IsOneShotLambda = ptext SLIT("OneShot")
 654
 655 instance Outputable LBVarInfo where
 656     ppr = pprLBVarInfo
 657
 658 instance Show LBVarInfo where
 659     showsPrec p c = showsPrecSDoc p (ppr c)
 660 \end{code}
 661
 662
 663 %************************************************************************
 664 %*                                                                      *
 665 \subsection{Bulk operations on IdInfo}
 666 %*                                                                      *
 667 %************************************************************************
 668
 669 @zapLamInfo@ is used for lambda binders that turn out to to be
 670 part of an unsaturated lambda
 671
 672 \begin{code}
 673 zapLamInfo :: IdInfo -> Maybe IdInfo
 674 zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand})
 675   | is_safe_occ occ && is_safe_dmd demand
 676   = Nothing
 677   | otherwise
 678   = Just (info {occInfo = safe_occ, newDemandInfo = Nothing})
 679   where
 680         -- The "unsafe" occ info is the ones that say I'm not in a lambda
 681         -- because that might not be true for an unsaturated lambda
 682     is_safe_occ (OneOcc in_lam _ _) = in_lam
 683     is_safe_occ other               = True
 684
 685     safe_occ = case occ of
 686                  OneOcc _ once int_cxt -> OneOcc insideLam once int_cxt
 687                  other                 -> occ
 688
 689     is_safe_dmd Nothing    = True
 690     is_safe_dmd (Just dmd) = not (isStrictDmd dmd)
 691 \end{code}
 692
 693 \begin{code}
 694 zapDemandInfo :: IdInfo -> Maybe IdInfo
 695 zapDemandInfo info@(IdInfo {newDemandInfo = dmd})
 696   | isJust dmd = Just (info {newDemandInfo = Nothing})
 697   | otherwise  = Nothing
 698 \end{code}
 699