compiler/basicTypes/IdInfo.lhs

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