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