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