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