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