ghc/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 TyCon FieldLabel  -- The Id for a record selector
 235
 236   | DataConWorkId DataCon       -- The Id for a data constructor *worker*
 237   | DataConWrapId DataCon       -- The Id for a data constructor *wrapper*
 238                                 -- [the only reasons we need to know is so that
 239                                 --  a) to support isImplicitId
 240                                 --  b) when desugaring a RecordCon we can get
 241                                 --     from the Id back to the data con]
 242
 243   | ClassOpId Class             -- An operation of a class
 244
 245   | PrimOpId PrimOp             -- The Id for a primitive operator
 246   | FCallId ForeignCall         -- The Id for a foreign call
 247
 248   | NotGlobalId                 -- Used as a convenient extra return value from globalIdDetails
 249
 250 notGlobalId = NotGlobalId
 251
 252 instance Outputable GlobalIdDetails where
 253     ppr NotGlobalId       = ptext SLIT("[***NotGlobalId***]")
 254     ppr VanillaGlobal     = ptext SLIT("[GlobalId]")
 255     ppr (DataConWorkId _) = ptext SLIT("[DataCon]")
 256     ppr (DataConWrapId _) = ptext SLIT("[DataConWrapper]")
 257     ppr (ClassOpId _)     = ptext SLIT("[ClassOp]")
 258     ppr (PrimOpId _)      = ptext SLIT("[PrimOp]")
 259     ppr (FCallId _)       = ptext SLIT("[ForeignCall]")
 260     ppr (RecordSelId _ _) = ptext SLIT("[RecSel]")
 261 \end{code}
 262
 263
 264 %************************************************************************
 265 %*                                                                      *
 266 \subsection{The main IdInfo type}
 267 %*                                                                      *
 268 %************************************************************************
 269
 270 An @IdInfo@ gives {\em optional} information about an @Id@.  If
 271 present it never lies, but it may not be present, in which case there
 272 is always a conservative assumption which can be made.
 273
 274 Two @Id@s may have different info even though they have the same
 275 @Unique@ (and are hence the same @Id@); for example, one might lack
 276 the properties attached to the other.
 277
 278 The @IdInfo@ gives information about the value, or definition, of the
 279 @Id@.  It does {\em not} contain information about the @Id@'s usage
 280 (except for @DemandInfo@? ToDo). (@lbvarInfo@ is also a marginal
 281 case.  KSW 1999-04).
 282
 283 \begin{code}
 284 data IdInfo
 285   = IdInfo {
 286         arityInfo       :: !ArityInfo,          -- Its arity
 287         specInfo        :: SpecInfo,            -- Specialisations of this function which exist
 288 #ifdef OLD_STRICTNESS
 289         cprInfo         :: CprInfo,             -- Function always constructs a product result
 290         demandInfo      :: Demand.Demand,       -- Whether or not it is definitely demanded
 291         strictnessInfo  :: StrictnessInfo,      -- Strictness properties
 292 #endif
 293         workerInfo      :: WorkerInfo,          -- Pointer to Worker Function
 294                                                 -- Within one module this is irrelevant; the
 295                                                 -- inlining of a worker is handled via the Unfolding
 296                                                 -- WorkerInfo is used *only* to indicate the form of
 297                                                 -- the RHS, so that interface files don't actually
 298                                                 -- need to contain the RHS; it can be derived from
 299                                                 -- the strictness info
 300
 301         unfoldingInfo   :: Unfolding,           -- Its unfolding
 302         cafInfo         :: CafInfo,             -- CAF info
 303         lbvarInfo       :: LBVarInfo,           -- Info about a lambda-bound variable
 304         inlinePragInfo  :: InlinePragInfo,      -- Inline pragma
 305         occInfo         :: OccInfo,             -- How it occurs
 306
 307         newStrictnessInfo :: Maybe StrictSig,   -- Reason for Maybe: the DmdAnal phase needs to
 308                                                 -- know whether whether this is the first visit,
 309                                                 -- so it can assign botSig.  Other customers want
 310                                                 -- topSig.  So Nothing is good.
 311
 312         newDemandInfo     :: Maybe Demand       -- Similarly we want to know if there's no
 313                                                 -- known demand yet, for when we are looking for
 314                                                 -- CPR info
 315     }
 316
 317 seqIdInfo :: IdInfo -> ()
 318 seqIdInfo (IdInfo {}) = ()
 319
 320 megaSeqIdInfo :: IdInfo -> ()
 321 megaSeqIdInfo info
 322   = seqSpecInfo (specInfo info)                 `seq`
 323     seqWorker (workerInfo info)                 `seq`
 324
 325 -- Omitting this improves runtimes a little, presumably because
 326 -- some unfoldings are not calculated at all
 327 --    seqUnfolding (unfoldingInfo info)         `seq`
 328
 329     seqNewDemandInfo (newDemandInfo info)       `seq`
 330     seqNewStrictnessInfo (newStrictnessInfo info) `seq`
 331
 332 #ifdef OLD_STRICTNESS
 333     Demand.seqDemand (demandInfo info)          `seq`
 334     seqStrictnessInfo (strictnessInfo info)     `seq`
 335     seqCpr (cprInfo info)                       `seq`
 336 #endif
 337
 338     seqCaf (cafInfo info)                       `seq`
 339     seqLBVar (lbvarInfo info)                   `seq`
 340     seqOccInfo (occInfo info)
 341 \end{code}
 342
 343 Setters
 344
 345 \begin{code}
 346 setWorkerInfo     info wk = wk `seq` info { workerInfo = wk }
 347 setSpecInfo       info sp = sp `seq` info { specInfo = sp }
 348 setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr }
 349 setOccInfo        info oc = oc `seq` info { occInfo = oc }
 350 #ifdef OLD_STRICTNESS
 351 setStrictnessInfo info st = st `seq` info { strictnessInfo = st }
 352 #endif
 353         -- Try to avoid spack leaks by seq'ing
 354
 355 setUnfoldingInfoLazily info uf  -- Lazy variant to avoid looking at the
 356   =                             -- unfolding of an imported Id unless necessary
 357     info { unfoldingInfo = uf } -- (In this case the demand-zapping is redundant.)
 358
 359 setUnfoldingInfo info uf
 360         -- We do *not* seq on the unfolding info, For some reason, doing so
 361         -- actually increases residency significantly.
 362   = info { unfoldingInfo = uf }
 363
 364 #ifdef OLD_STRICTNESS
 365 setDemandInfo     info dd = info { demandInfo = dd }
 366 setCprInfo        info cp = info { cprInfo = cp }
 367 #endif
 368
 369 setArityInfo      info ar  = info { arityInfo = ar  }
 370 setCafInfo        info caf = info { cafInfo = caf }
 371
 372 setLBVarInfo      info lb = {-lb `seq`-} info { lbvarInfo = lb }
 373
 374 setNewDemandInfo     info dd = dd `seq` info { newDemandInfo = dd }
 375 setNewStrictnessInfo info dd = dd `seq` info { newStrictnessInfo = dd }
 376 \end{code}
 377
 378
 379 \begin{code}
 380 vanillaIdInfo :: IdInfo
 381 vanillaIdInfo
 382   = IdInfo {
 383             cafInfo             = vanillaCafInfo,
 384             arityInfo           = unknownArity,
 385 #ifdef OLD_STRICTNESS
 386             cprInfo             = NoCPRInfo,
 387             demandInfo          = wwLazy,
 388             strictnessInfo      = NoStrictnessInfo,
 389 #endif
 390             specInfo            = emptySpecInfo,
 391             workerInfo          = NoWorker,
 392             unfoldingInfo       = noUnfolding,
 393             lbvarInfo           = NoLBVarInfo,
 394             inlinePragInfo      = AlwaysActive,
 395             occInfo             = NoOccInfo,
 396             newDemandInfo       = Nothing,
 397             newStrictnessInfo   = Nothing
 398            }
 399
 400 noCafIdInfo  = vanillaIdInfo `setCafInfo`    NoCafRefs
 401         -- Used for built-in type Ids in MkId.
 402 \end{code}
 403
 404
 405 %************************************************************************
 406 %*                                                                      *
 407 \subsection[arity-IdInfo]{Arity info about an @Id@}
 408 %*                                                                      *
 409 %************************************************************************
 410
 411 For locally-defined Ids, the code generator maintains its own notion
 412 of their arities; so it should not be asking...  (but other things
 413 besides the code-generator need arity info!)
 414
 415 \begin{code}
 416 type ArityInfo = Arity
 417         -- A partial application of this Id to up to n-1 value arguments
 418         -- does essentially no work.  That is not necessarily the
 419         -- same as saying that it has n leading lambdas, because coerces
 420         -- may get in the way.
 421
 422         -- The arity might increase later in the compilation process, if
 423         -- an extra lambda floats up to the binding site.
 424
 425 unknownArity = 0 :: Arity
 426
 427 ppArityInfo 0 = empty
 428 ppArityInfo n = hsep [ptext SLIT("Arity"), int n]
 429 \end{code}
 430
 431 %************************************************************************
 432 %*                                                                      *
 433 \subsection{Inline-pragma information}
 434 %*                                                                      *
 435 %************************************************************************
 436
 437 \begin{code}
 438 type InlinePragInfo = Activation
 439         -- Tells when the inlining is active
 440         -- When it is active the thing may be inlined, depending on how
 441         -- big it is.
 442         --
 443         -- If there was an INLINE pragma, then as a separate matter, the
 444         -- RHS will have been made to look small with a CoreSyn Inline Note
 445
 446         -- The default InlinePragInfo is AlwaysActive, so the info serves
 447         -- entirely as a way to inhibit inlining until we want it
 448 \end{code}
 449
 450
 451 %************************************************************************
 452 %*                                                                      *
 453         SpecInfo
 454 %*                                                                      *
 455 %************************************************************************
 456
 457 \begin{code}
 458 -- CoreRules is used only in an idSpecialisation (move to IdInfo?)
 459 data SpecInfo
 460   = SpecInfo [CoreRule] VarSet  -- Locally-defined free vars of RHSs
 461
 462 emptySpecInfo :: SpecInfo
 463 emptySpecInfo = SpecInfo [] emptyVarSet
 464
 465 isEmptySpecInfo :: SpecInfo -> Bool
 466 isEmptySpecInfo (SpecInfo rs _) = null rs
 467
 468 specInfoFreeVars :: SpecInfo -> VarSet
 469 specInfoFreeVars (SpecInfo _ fvs) = fvs
 470
 471 specInfoRules :: SpecInfo -> [CoreRule]
 472 specInfoRules (SpecInfo rules _) = rules
 473
 474 seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs
 475 \end{code}
 476
 477
 478 %************************************************************************
 479 %*                                                                      *
 480 \subsection[worker-IdInfo]{Worker info about an @Id@}
 481 %*                                                                      *
 482 %************************************************************************
 483
 484 If this Id has a worker then we store a reference to it. Worker
 485 functions are generated by the worker/wrapper pass.  This uses
 486 information from strictness analysis.
 487
 488 There might not be a worker, even for a strict function, because:
 489 (a) the function might be small enough to inline, so no need
 490     for w/w split
 491 (b) the strictness info might be "SSS" or something, so no w/w split.
 492
 493 Sometimes the arity of a wrapper changes from the original arity from
 494 which it was generated, so we always emit the "original" arity into
 495 the interface file, as part of the worker info.
 496
 497 How can this happen?  Sometimes we get
 498         f = coerce t (\x y -> $wf x y)
 499 at the moment of w/w split; but the eta reducer turns it into
 500         f = coerce t $wf
 501 which is perfectly fine except that the exposed arity so far as
 502 the code generator is concerned (zero) differs from the arity
 503 when we did the split (2).
 504
 505 All this arises because we use 'arity' to mean "exactly how many
 506 top level lambdas are there" in interface files; but during the
 507 compilation of this module it means "how many things can I apply
 508 this to".
 509
 510 \begin{code}
 511
 512 data WorkerInfo = NoWorker
 513                 | HasWorker Id Arity
 514         -- The Arity is the arity of the *wrapper* at the moment of the
 515         -- w/w split.  See notes above.
 516
 517 seqWorker :: WorkerInfo -> ()
 518 seqWorker (HasWorker id a) = id `seq` a `seq` ()
 519 seqWorker NoWorker         = ()
 520
 521 ppWorkerInfo NoWorker            = empty
 522 ppWorkerInfo (HasWorker wk_id _) = ptext SLIT("Worker") <+> ppr wk_id
 523
 524 workerExists :: WorkerInfo -> Bool
 525 workerExists NoWorker        = False
 526 workerExists (HasWorker _ _) = True
 527
 528 workerId :: WorkerInfo -> Id
 529 workerId (HasWorker id _) = id
 530
 531 wrapperArity :: WorkerInfo -> Arity
 532 wrapperArity (HasWorker _ a) = a
 533 \end{code}
 534
 535
 536 %************************************************************************
 537 %*                                                                      *
 538 \subsection[CG-IdInfo]{Code generator-related information}
 539 %*                                                                      *
 540 %************************************************************************
 541
 542 \begin{code}
 543 -- CafInfo is used to build Static Reference Tables (see simplStg/SRT.lhs).
 544
 545 data CafInfo
 546         = MayHaveCafRefs                -- either:
 547                                         -- (1) A function or static constructor
 548                                         --     that refers to one or more CAFs,
 549                                         -- (2) A real live CAF
 550
 551         | NoCafRefs                     -- A function or static constructor
 552                                         -- that refers to no CAFs.
 553
 554 vanillaCafInfo = MayHaveCafRefs         -- Definitely safe
 555
 556 mayHaveCafRefs  MayHaveCafRefs = True
 557 mayHaveCafRefs _               = False
 558
 559 seqCaf c = c `seq` ()
 560
 561 ppCafInfo NoCafRefs = ptext SLIT("NoCafRefs")
 562 ppCafInfo MayHaveCafRefs = empty
 563 \end{code}
 564
 565 %************************************************************************
 566 %*                                                                      *
 567 \subsection[cpr-IdInfo]{Constructed Product Result info about an @Id@}
 568 %*                                                                      *
 569 %************************************************************************
 570
 571 If the @Id@ is a function then it may have CPR info. A CPR analysis
 572 phase detects whether:
 573
 574 \begin{enumerate}
 575 \item
 576 The function's return value has a product type, i.e. an algebraic  type
 577 with a single constructor. Examples of such types are tuples and boxed
 578 primitive values.
 579 \item
 580 The function always 'constructs' the value that it is returning.  It
 581 must do this on every path through,  and it's OK if it calls another
 582 function which constructs the result.
 583 \end{enumerate}
 584
 585 If this is the case then we store a template which tells us the
 586 function has the CPR property and which components of the result are
 587 also CPRs.
 588
 589 \begin{code}
 590 #ifdef OLD_STRICTNESS
 591 data CprInfo
 592   = NoCPRInfo
 593   | ReturnsCPR  -- Yes, this function returns a constructed product
 594                 -- Implicitly, this means "after the function has been applied
 595                 -- to all its arguments", so the worker/wrapper builder in
 596                 -- WwLib.mkWWcpr checks that that it is indeed saturated before
 597                 -- making use of the CPR info
 598
 599         -- We used to keep nested info about sub-components, but
 600         -- we never used it so I threw it away
 601
 602 seqCpr :: CprInfo -> ()
 603 seqCpr ReturnsCPR = ()
 604 seqCpr NoCPRInfo  = ()
 605
 606 noCprInfo       = NoCPRInfo
 607
 608 ppCprInfo NoCPRInfo  = empty
 609 ppCprInfo ReturnsCPR = ptext SLIT("__M")
 610
 611 instance Outputable CprInfo where
 612     ppr = ppCprInfo
 613
 614 instance Show CprInfo where
 615     showsPrec p c = showsPrecSDoc p (ppr c)
 616 #endif
 617 \end{code}
 618
 619
 620 %************************************************************************
 621 %*                                                                      *
 622 \subsection[lbvar-IdInfo]{Lambda-bound var info about an @Id@}
 623 %*                                                                      *
 624 %************************************************************************
 625
 626 If the @Id@ is a lambda-bound variable then it may have lambda-bound
 627 var info.  Sometimes we know whether the lambda binding this var is a
 628 ``one-shot'' lambda; that is, whether it is applied at most once.
 629
 630 This information may be useful in optimisation, as computations may
 631 safely be floated inside such a lambda without risk of duplicating
 632 work.
 633
 634 \begin{code}
 635 data LBVarInfo = NoLBVarInfo
 636                | IsOneShotLambda        -- The lambda is applied at most once).
 637
 638 seqLBVar l = l `seq` ()
 639 \end{code}
 640
 641 \begin{code}
 642 hasNoLBVarInfo NoLBVarInfo     = True
 643 hasNoLBVarInfo IsOneShotLambda = False
 644
 645 noLBVarInfo = NoLBVarInfo
 646
 647 pprLBVarInfo NoLBVarInfo     = empty
 648 pprLBVarInfo IsOneShotLambda = ptext SLIT("OneShot")
 649
 650 instance Outputable LBVarInfo where
 651     ppr = pprLBVarInfo
 652
 653 instance Show LBVarInfo where
 654     showsPrec p c = showsPrecSDoc p (ppr c)
 655 \end{code}
 656
 657
 658 %************************************************************************
 659 %*                                                                      *
 660 \subsection{Bulk operations on IdInfo}
 661 %*                                                                      *
 662 %************************************************************************
 663
 664 @zapLamInfo@ is used for lambda binders that turn out to to be
 665 part of an unsaturated lambda
 666
 667 \begin{code}
 668 zapLamInfo :: IdInfo -> Maybe IdInfo
 669 zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand})
 670   | is_safe_occ occ && is_safe_dmd demand
 671   = Nothing
 672   | otherwise
 673   = Just (info {occInfo = safe_occ, newDemandInfo = Nothing})
 674   where
 675         -- The "unsafe" occ info is the ones that say I'm not in a lambda
 676         -- because that might not be true for an unsaturated lambda
 677     is_safe_occ (OneOcc in_lam _ _) = in_lam
 678     is_safe_occ other               = True
 679
 680     safe_occ = case occ of
 681                  OneOcc _ once int_cxt -> OneOcc insideLam once int_cxt
 682                  other                 -> occ
 683
 684     is_safe_dmd Nothing    = True
 685     is_safe_dmd (Just dmd) = not (isStrictDmd dmd)
 686 \end{code}
 687
 688 \begin{code}
 689 zapDemandInfo :: IdInfo -> Maybe IdInfo
 690 zapDemandInfo info@(IdInfo {newDemandInfo = dmd})
 691   | isJust dmd = Just (info {newDemandInfo = Nothing})
 692   | otherwise  = Nothing
 693 \end{code}
 694