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) we can  suppress printing a definition in the interface file
 240                                 --  b) when typechecking a pattern we can get from the
 241                                 --     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 \end{code}
 446
 447
 448 %************************************************************************
 449 %*                                                                      *
 450         SpecInfo
 451 %*                                                                      *
 452 %************************************************************************
 453
 454 \begin{code}
 455 -- CoreRules is used only in an idSpecialisation (move to IdInfo?)
 456 data SpecInfo
 457   = SpecInfo [CoreRule] VarSet  -- Locally-defined free vars of RHSs
 458
 459 emptySpecInfo :: SpecInfo
 460 emptySpecInfo = SpecInfo [] emptyVarSet
 461
 462 isEmptySpecInfo :: SpecInfo -> Bool
 463 isEmptySpecInfo (SpecInfo rs _) = null rs
 464
 465 specInfoFreeVars :: SpecInfo -> VarSet
 466 specInfoFreeVars (SpecInfo _ fvs) = fvs
 467
 468 specInfoRules :: SpecInfo -> [CoreRule]
 469 specInfoRules (SpecInfo rules _) = rules
 470
 471 seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs
 472 \end{code}
 473
 474
 475 %************************************************************************
 476 %*                                                                      *
 477 \subsection[worker-IdInfo]{Worker info about an @Id@}
 478 %*                                                                      *
 479 %************************************************************************
 480
 481 If this Id has a worker then we store a reference to it. Worker
 482 functions are generated by the worker/wrapper pass.  This uses
 483 information from strictness analysis.
 484
 485 There might not be a worker, even for a strict function, because:
 486 (a) the function might be small enough to inline, so no need
 487     for w/w split
 488 (b) the strictness info might be "SSS" or something, so no w/w split.
 489
 490 Sometimes the arity of a wrapper changes from the original arity from
 491 which it was generated, so we always emit the "original" arity into
 492 the interface file, as part of the worker info.
 493
 494 How can this happen?  Sometimes we get
 495         f = coerce t (\x y -> $wf x y)
 496 at the moment of w/w split; but the eta reducer turns it into
 497         f = coerce t $wf
 498 which is perfectly fine except that the exposed arity so far as
 499 the code generator is concerned (zero) differs from the arity
 500 when we did the split (2).
 501
 502 All this arises because we use 'arity' to mean "exactly how many
 503 top level lambdas are there" in interface files; but during the
 504 compilation of this module it means "how many things can I apply
 505 this to".
 506
 507 \begin{code}
 508
 509 data WorkerInfo = NoWorker
 510                 | HasWorker Id Arity
 511         -- The Arity is the arity of the *wrapper* at the moment of the
 512         -- w/w split.  See notes above.
 513
 514 seqWorker :: WorkerInfo -> ()
 515 seqWorker (HasWorker id a) = id `seq` a `seq` ()
 516 seqWorker NoWorker         = ()
 517
 518 ppWorkerInfo NoWorker            = empty
 519 ppWorkerInfo (HasWorker wk_id _) = ptext SLIT("Worker") <+> ppr wk_id
 520
 521 workerExists :: WorkerInfo -> Bool
 522 workerExists NoWorker        = False
 523 workerExists (HasWorker _ _) = True
 524
 525 workerId :: WorkerInfo -> Id
 526 workerId (HasWorker id _) = id
 527
 528 wrapperArity :: WorkerInfo -> Arity
 529 wrapperArity (HasWorker _ a) = a
 530 \end{code}
 531
 532
 533 %************************************************************************
 534 %*                                                                      *
 535 \subsection[CG-IdInfo]{Code generator-related information}
 536 %*                                                                      *
 537 %************************************************************************
 538
 539 \begin{code}
 540 -- CafInfo is used to build Static Reference Tables (see simplStg/SRT.lhs).
 541
 542 data CafInfo
 543         = MayHaveCafRefs                -- either:
 544                                         -- (1) A function or static constructor
 545                                         --     that refers to one or more CAFs,
 546                                         -- (2) A real live CAF
 547
 548         | NoCafRefs                     -- A function or static constructor
 549                                         -- that refers to no CAFs.
 550
 551 vanillaCafInfo = MayHaveCafRefs         -- Definitely safe
 552
 553 mayHaveCafRefs  MayHaveCafRefs = True
 554 mayHaveCafRefs _               = False
 555
 556 seqCaf c = c `seq` ()
 557
 558 ppCafInfo NoCafRefs = ptext SLIT("NoCafRefs")
 559 ppCafInfo MayHaveCafRefs = empty
 560 \end{code}
 561
 562 %************************************************************************
 563 %*                                                                      *
 564 \subsection[cpr-IdInfo]{Constructed Product Result info about an @Id@}
 565 %*                                                                      *
 566 %************************************************************************
 567
 568 If the @Id@ is a function then it may have CPR info. A CPR analysis
 569 phase detects whether:
 570
 571 \begin{enumerate}
 572 \item
 573 The function's return value has a product type, i.e. an algebraic  type
 574 with a single constructor. Examples of such types are tuples and boxed
 575 primitive values.
 576 \item
 577 The function always 'constructs' the value that it is returning.  It
 578 must do this on every path through,  and it's OK if it calls another
 579 function which constructs the result.
 580 \end{enumerate}
 581
 582 If this is the case then we store a template which tells us the
 583 function has the CPR property and which components of the result are
 584 also CPRs.
 585
 586 \begin{code}
 587 #ifdef OLD_STRICTNESS
 588 data CprInfo
 589   = NoCPRInfo
 590   | ReturnsCPR  -- Yes, this function returns a constructed product
 591                 -- Implicitly, this means "after the function has been applied
 592                 -- to all its arguments", so the worker/wrapper builder in
 593                 -- WwLib.mkWWcpr checks that that it is indeed saturated before
 594                 -- making use of the CPR info
 595
 596         -- We used to keep nested info about sub-components, but
 597         -- we never used it so I threw it away
 598
 599 seqCpr :: CprInfo -> ()
 600 seqCpr ReturnsCPR = ()
 601 seqCpr NoCPRInfo  = ()
 602
 603 noCprInfo       = NoCPRInfo
 604
 605 ppCprInfo NoCPRInfo  = empty
 606 ppCprInfo ReturnsCPR = ptext SLIT("__M")
 607
 608 instance Outputable CprInfo where
 609     ppr = ppCprInfo
 610
 611 instance Show CprInfo where
 612     showsPrec p c = showsPrecSDoc p (ppr c)
 613 #endif
 614 \end{code}
 615
 616
 617 %************************************************************************
 618 %*                                                                      *
 619 \subsection[lbvar-IdInfo]{Lambda-bound var info about an @Id@}
 620 %*                                                                      *
 621 %************************************************************************
 622
 623 If the @Id@ is a lambda-bound variable then it may have lambda-bound
 624 var info.  Sometimes we know whether the lambda binding this var is a
 625 ``one-shot'' lambda; that is, whether it is applied at most once.
 626
 627 This information may be useful in optimisation, as computations may
 628 safely be floated inside such a lambda without risk of duplicating
 629 work.
 630
 631 \begin{code}
 632 data LBVarInfo = NoLBVarInfo
 633                | IsOneShotLambda        -- The lambda is applied at most once).
 634
 635 seqLBVar l = l `seq` ()
 636 \end{code}
 637
 638 \begin{code}
 639 hasNoLBVarInfo NoLBVarInfo     = True
 640 hasNoLBVarInfo IsOneShotLambda = False
 641
 642 noLBVarInfo = NoLBVarInfo
 643
 644 pprLBVarInfo NoLBVarInfo     = empty
 645 pprLBVarInfo IsOneShotLambda = ptext SLIT("OneShot")
 646
 647 instance Outputable LBVarInfo where
 648     ppr = pprLBVarInfo
 649
 650 instance Show LBVarInfo where
 651     showsPrec p c = showsPrecSDoc p (ppr c)
 652 \end{code}
 653
 654
 655 %************************************************************************
 656 %*                                                                      *
 657 \subsection{Bulk operations on IdInfo}
 658 %*                                                                      *
 659 %************************************************************************
 660
 661 @zapLamInfo@ is used for lambda binders that turn out to to be
 662 part of an unsaturated lambda
 663
 664 \begin{code}
 665 zapLamInfo :: IdInfo -> Maybe IdInfo
 666 zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand})
 667   | is_safe_occ occ && is_safe_dmd demand
 668   = Nothing
 669   | otherwise
 670   = Just (info {occInfo = safe_occ, newDemandInfo = Nothing})
 671   where
 672         -- The "unsafe" occ info is the ones that say I'm not in a lambda
 673         -- because that might not be true for an unsaturated lambda
 674     is_safe_occ (OneOcc in_lam once) = in_lam
 675     is_safe_occ other                = True
 676
 677     safe_occ = case occ of
 678                  OneOcc _ once -> OneOcc insideLam once
 679                  other         -> occ
 680
 681     is_safe_dmd Nothing    = True
 682     is_safe_dmd (Just dmd) = not (isStrictDmd dmd)
 683 \end{code}
 684
 685 \begin{code}
 686 zapDemandInfo :: IdInfo -> Maybe IdInfo
 687 zapDemandInfo info@(IdInfo {newDemandInfo = dmd})
 688   | isJust dmd = Just (info {newDemandInfo = Nothing})
 689   | otherwise  = Nothing
 690 \end{code}
 691