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