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