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