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/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,
  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 Var
  93 import VarSet
  94 import BasicTypes
  95 import DataCon
  96 import TyCon
  97 import ForeignCall
  98 import NewDemand
  99 import Outputable
 100 import Module
 101
 102 import Data.Maybe
 103
 104 #ifdef OLD_STRICTNESS
 105 import Name
 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 of rules
 478                         -- Note [Rule dependency info]
 479
 480 emptySpecInfo :: SpecInfo
 481 emptySpecInfo = SpecInfo [] emptyVarSet
 482
 483 isEmptySpecInfo :: SpecInfo -> Bool
 484 isEmptySpecInfo (SpecInfo rs _) = null rs
 485
 486 specInfoFreeVars :: SpecInfo -> VarSet
 487 specInfoFreeVars (SpecInfo _ fvs) = fvs
 488
 489 specInfoRules :: SpecInfo -> [CoreRule]
 490 specInfoRules (SpecInfo rules _) = rules
 491
 492 seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs
 493 \end{code}
 494
 495 Note [Rule dependency info]
 496 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
 497 THe VarSet in a SpecInfo is used for dependency analysis in the
 498 occurrence analyser.  We must track free vars in *both* lhs and rhs.  Why both?
 499 Consider
 500         x = y
 501         RULE f x = 4
 502 Then if we substitute y for x, we'd better do so in the
 503  rule's LHS too, so we'd better ensure the dependency is respsected
 504
 505
 506
 507 %************************************************************************
 508 %*                                                                      *
 509 \subsection[worker-IdInfo]{Worker info about an @Id@}
 510 %*                                                                      *
 511 %************************************************************************
 512
 513 If this Id has a worker then we store a reference to it. Worker
 514 functions are generated by the worker/wrapper pass.  This uses
 515 information from strictness analysis.
 516
 517 There might not be a worker, even for a strict function, because:
 518 (a) the function might be small enough to inline, so no need
 519     for w/w split
 520 (b) the strictness info might be "SSS" or something, so no w/w split.
 521
 522 Sometimes the arity of a wrapper changes from the original arity from
 523 which it was generated, so we always emit the "original" arity into
 524 the interface file, as part of the worker info.
 525
 526 How can this happen?  Sometimes we get
 527         f = coerce t (\x y -> $wf x y)
 528 at the moment of w/w split; but the eta reducer turns it into
 529         f = coerce t $wf
 530 which is perfectly fine except that the exposed arity so far as
 531 the code generator is concerned (zero) differs from the arity
 532 when we did the split (2).
 533
 534 All this arises because we use 'arity' to mean "exactly how many
 535 top level lambdas are there" in interface files; but during the
 536 compilation of this module it means "how many things can I apply
 537 this to".
 538
 539 \begin{code}
 540
 541 data WorkerInfo = NoWorker
 542                 | HasWorker Id Arity
 543         -- The Arity is the arity of the *wrapper* at the moment of the
 544         -- w/w split.  See notes above.
 545
 546 seqWorker :: WorkerInfo -> ()
 547 seqWorker (HasWorker id a) = id `seq` a `seq` ()
 548 seqWorker NoWorker         = ()
 549
 550 ppWorkerInfo NoWorker            = empty
 551 ppWorkerInfo (HasWorker wk_id _) = ptext SLIT("Worker") <+> ppr wk_id
 552
 553 workerExists :: WorkerInfo -> Bool
 554 workerExists NoWorker        = False
 555 workerExists (HasWorker _ _) = True
 556
 557 workerId :: WorkerInfo -> Id
 558 workerId (HasWorker id _) = id
 559
 560 wrapperArity :: WorkerInfo -> Arity
 561 wrapperArity (HasWorker _ a) = a
 562 \end{code}
 563
 564
 565 %************************************************************************
 566 %*                                                                      *
 567 \subsection[CG-IdInfo]{Code generator-related information}
 568 %*                                                                      *
 569 %************************************************************************
 570
 571 \begin{code}
 572 -- CafInfo is used to build Static Reference Tables (see simplStg/SRT.lhs).
 573
 574 data CafInfo
 575         = MayHaveCafRefs                -- either:
 576                                         -- (1) A function or static constructor
 577                                         --     that refers to one or more CAFs,
 578                                         -- (2) A real live CAF
 579
 580         | NoCafRefs                     -- A function or static constructor
 581                                         -- that refers to no CAFs.
 582
 583 vanillaCafInfo = MayHaveCafRefs         -- Definitely safe
 584
 585 mayHaveCafRefs  MayHaveCafRefs = True
 586 mayHaveCafRefs _               = False
 587
 588 seqCaf c = c `seq` ()
 589
 590 ppCafInfo NoCafRefs = ptext SLIT("NoCafRefs")
 591 ppCafInfo MayHaveCafRefs = empty
 592 \end{code}
 593
 594 %************************************************************************
 595 %*                                                                      *
 596 \subsection[cpr-IdInfo]{Constructed Product Result info about an @Id@}
 597 %*                                                                      *
 598 %************************************************************************
 599
 600 If the @Id@ is a function then it may have CPR info. A CPR analysis
 601 phase detects whether:
 602
 603 \begin{enumerate}
 604 \item
 605 The function's return value has a product type, i.e. an algebraic  type
 606 with a single constructor. Examples of such types are tuples and boxed
 607 primitive values.
 608 \item
 609 The function always 'constructs' the value that it is returning.  It
 610 must do this on every path through,  and it's OK if it calls another
 611 function which constructs the result.
 612 \end{enumerate}
 613
 614 If this is the case then we store a template which tells us the
 615 function has the CPR property and which components of the result are
 616 also CPRs.
 617
 618 \begin{code}
 619 #ifdef OLD_STRICTNESS
 620 data CprInfo
 621   = NoCPRInfo
 622   | ReturnsCPR  -- Yes, this function returns a constructed product
 623                 -- Implicitly, this means "after the function has been applied
 624                 -- to all its arguments", so the worker/wrapper builder in
 625                 -- WwLib.mkWWcpr checks that that it is indeed saturated before
 626                 -- making use of the CPR info
 627
 628         -- We used to keep nested info about sub-components, but
 629         -- we never used it so I threw it away
 630
 631 seqCpr :: CprInfo -> ()
 632 seqCpr ReturnsCPR = ()
 633 seqCpr NoCPRInfo  = ()
 634
 635 noCprInfo       = NoCPRInfo
 636
 637 ppCprInfo NoCPRInfo  = empty
 638 ppCprInfo ReturnsCPR = ptext SLIT("__M")
 639
 640 instance Outputable CprInfo where
 641     ppr = ppCprInfo
 642
 643 instance Show CprInfo where
 644     showsPrec p c = showsPrecSDoc p (ppr c)
 645 #endif
 646 \end{code}
 647
 648
 649 %************************************************************************
 650 %*                                                                      *
 651 \subsection[lbvar-IdInfo]{Lambda-bound var info about an @Id@}
 652 %*                                                                      *
 653 %************************************************************************
 654
 655 If the @Id@ is a lambda-bound variable then it may have lambda-bound
 656 var info.  Sometimes we know whether the lambda binding this var is a
 657 ``one-shot'' lambda; that is, whether it is applied at most once.
 658
 659 This information may be useful in optimisation, as computations may
 660 safely be floated inside such a lambda without risk of duplicating
 661 work.
 662
 663 \begin{code}
 664 data LBVarInfo = NoLBVarInfo
 665                | IsOneShotLambda        -- The lambda is applied at most once).
 666
 667 seqLBVar l = l `seq` ()
 668 \end{code}
 669
 670 \begin{code}
 671 hasNoLBVarInfo NoLBVarInfo     = True
 672 hasNoLBVarInfo IsOneShotLambda = False
 673
 674 noLBVarInfo = NoLBVarInfo
 675
 676 pprLBVarInfo NoLBVarInfo     = empty
 677 pprLBVarInfo IsOneShotLambda = ptext SLIT("OneShot")
 678
 679 instance Outputable LBVarInfo where
 680     ppr = pprLBVarInfo
 681
 682 instance Show LBVarInfo where
 683     showsPrec p c = showsPrecSDoc p (ppr c)
 684 \end{code}
 685
 686
 687 %************************************************************************
 688 %*                                                                      *
 689 \subsection{Bulk operations on IdInfo}
 690 %*                                                                      *
 691 %************************************************************************
 692
 693 @zapLamInfo@ is used for lambda binders that turn out to to be
 694 part of an unsaturated lambda
 695
 696 \begin{code}
 697 zapLamInfo :: IdInfo -> Maybe IdInfo
 698 zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand})
 699   | is_safe_occ occ && is_safe_dmd demand
 700   = Nothing
 701   | otherwise
 702   = Just (info {occInfo = safe_occ, newDemandInfo = Nothing})
 703   where
 704         -- The "unsafe" occ info is the ones that say I'm not in a lambda
 705         -- because that might not be true for an unsaturated lambda
 706     is_safe_occ (OneOcc in_lam _ _) = in_lam
 707     is_safe_occ other               = True
 708
 709     safe_occ = case occ of
 710                  OneOcc _ once int_cxt -> OneOcc insideLam once int_cxt
 711                  other                 -> occ
 712
 713     is_safe_dmd Nothing    = True
 714     is_safe_dmd (Just dmd) = not (isStrictDmd dmd)
 715 \end{code}
 716
 717 \begin{code}
 718 zapDemandInfo :: IdInfo -> Maybe IdInfo
 719 zapDemandInfo info@(IdInfo {newDemandInfo = dmd})
 720   | isJust dmd = Just (info {newDemandInfo = Nothing})
 721   | otherwise  = Nothing
 722 \end{code}
 723
 724 \begin{code}
 725 zapFragileInfo :: IdInfo -> Maybe IdInfo
 726 -- Zap info that depends on free variables
 727 zapFragileInfo info = Just (info `setSpecInfo` emptySpecInfo
 728                                  `setWorkerInfo` NoWorker
 729                                  `setUnfoldingInfo` NoUnfolding)
 730 \end{code}
 731
 732 %************************************************************************
 733 %*                                                                      *
 734 \subsection{TickBoxOp}
 735 %*                                                                      *
 736 %************************************************************************
 737
 738 \begin{code}
 739 type TickBoxId = Int
 740
 741 data TickBoxOp
 742    = TickBox Module {-# UNPACK #-} !TickBoxId
 743           -- ^Tick box for Hpc-style coverage
 744
 745 instance Outputable TickBoxOp where
 746     ppr (TickBox mod n)         = ptext SLIT("tick") <+> ppr (mod,n)
 747 \end{code}