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