ghc/compiler/basicTypes/IdInfo.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
   3 %
   4 \section[IdInfo]{@IdInfos@: Non-essential information about @Ids@}
   5
   6 (And a pretty good illustration of quite a few things wrong with
   7 Haskell. [WDP 94/11])
   8
   9 \begin{code}
  10 module IdInfo (
  11         GlobalIdDetails(..), notGlobalId,       -- Not abstract
  12
  13         IdInfo,         -- Abstract
  14         vanillaIdInfo, noCafIdInfo, hasCafIdInfo,
  15         seqIdInfo, megaSeqIdInfo,
  16
  17         -- Zapping
  18         zapLamInfo, zapDemandInfo,
  19         shortableIdInfo, copyIdInfo,
  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
  30         -- Strictness; imported from Demand
  31         StrictnessInfo(..),
  32         mkStrictnessInfo, noStrictnessInfo,
  33         ppStrictnessInfo,isBottomingStrictness,
  34         setAllStrictnessInfo,
  35
  36         -- Worker
  37         WorkerInfo(..), workerExists, wrapperArity, workerId,
  38         workerInfo, setWorkerInfo, ppWorkerInfo,
  39
  40         -- Unfolding
  41         unfoldingInfo, setUnfoldingInfo,
  42
  43 #ifdef OLD_STRICTNESS
  44         -- Old DemandInfo and StrictnessInfo
  45         demandInfo, setDemandInfo,
  46         strictnessInfo, setStrictnessInfo,
  47         cprInfoFromNewStrictness,
  48         oldStrictnessFromNew, newStrictnessFromOld,
  49         oldDemand, newDemand,
  50
  51         -- Constructed Product Result Info
  52         CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo,
  53 #endif
  54
  55         -- Inline prags
  56         InlinePragInfo,
  57         inlinePragInfo, setInlinePragInfo,
  58
  59         -- Occurrence info
  60         OccInfo(..), isFragileOcc, isDeadOcc, isLoopBreaker,
  61         InsideLam, OneBranch, insideLam, notInsideLam, oneBranch, notOneBranch,
  62         occInfo, setOccInfo,
  63
  64         -- Specialisation
  65         specInfo, setSpecInfo,
  66
  67         -- CG info
  68         CgInfo(..), cgInfo, setCgInfo,  pprCgInfo,
  69         cgCafInfo, vanillaCgInfo,
  70         CgInfoEnv, lookupCgInfo,
  71
  72         -- CAF info
  73         CafInfo(..), ppCafInfo, setCafInfo, mayHaveCafRefs,
  74
  75         -- Lambda-bound variable info
  76         LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo, hasNoLBVarInfo
  77     ) where
  78
  79 #include "HsVersions.h"
  80
  81
  82 import CoreSyn
  83 import Type             ( Type, usOnce, eqUsage )
  84 import PrimOp           ( PrimOp )
  85 import NameEnv          ( NameEnv, lookupNameEnv )
  86 import Name             ( Name )
  87 import Var              ( Id )
  88 import BasicTypes       ( OccInfo(..), isFragileOcc, isDeadOcc, seqOccInfo, isLoopBreaker,
  89                           InsideLam, insideLam, notInsideLam,
  90                           OneBranch, oneBranch, notOneBranch,
  91                           Arity,
  92                           Activation(..)
  93                         )
  94 import DataCon          ( DataCon )
  95 import ForeignCall      ( ForeignCall )
  96 import FieldLabel       ( FieldLabel )
  97 import Type             ( usOnce )
  98 import Demand           hiding( Demand, seqDemand )
  99 import qualified Demand
 100 import NewDemand
 101 import Outputable
 102 import Maybe            ( isJust )
 103 #ifdef OLD_STRICTNESS
 104 import Util             ( listLengthCmp )
 105 import List             ( replicate )
 106 #endif
 107
 108 -- infixl so you can say (id `set` a `set` b)
 109 infixl  1 `setSpecInfo`,
 110           `setArityInfo`,
 111           `setInlinePragInfo`,
 112           `setUnfoldingInfo`,
 113           `setWorkerInfo`,
 114           `setLBVarInfo`,
 115           `setOccInfo`,
 116           `setCgInfo`,
 117           `setCafInfo`,
 118           `setNewStrictnessInfo`,
 119           `setAllStrictnessInfo`,
 120           `setNewDemandInfo`
 121 #ifdef OLD_STRICTNESS
 122           , `setCprInfo`
 123           , `setDemandInfo`
 124           , `setStrictnessInfo`
 125 #endif
 126 \end{code}
 127
 128 %************************************************************************
 129 %*                                                                      *
 130 \subsection{New strictness info}
 131 %*                                                                      *
 132 %************************************************************************
 133
 134 To be removed later
 135
 136 \begin{code}
 137 -- setAllStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo
 138 -- Set old and new strictness info
 139 setAllStrictnessInfo info Nothing
 140   = info { newStrictnessInfo = Nothing
 141 #ifdef OLD_STRICTNESS
 142          , strictnessInfo = NoStrictnessInfo
 143          , cprInfo = NoCPRInfo
 144 #endif
 145          }
 146
 147 setAllStrictnessInfo info (Just sig)
 148   = info { newStrictnessInfo = Just sig
 149 #ifdef OLD_STRICTNESS
 150          , strictnessInfo = oldStrictnessFromNew sig
 151          , cprInfo = cprInfoFromNewStrictness sig
 152 #endif
 153          }
 154
 155 seqNewStrictnessInfo Nothing = ()
 156 seqNewStrictnessInfo (Just ty) = seqStrictSig ty
 157
 158 pprNewStrictness Nothing = empty
 159 pprNewStrictness (Just sig) = ftext FSLIT("Str:") <+> ppr sig
 160
 161 #ifdef OLD_STRICTNESS
 162 oldStrictnessFromNew :: StrictSig -> Demand.StrictnessInfo
 163 oldStrictnessFromNew sig = mkStrictnessInfo (map oldDemand dmds, isBotRes res_info)
 164                          where
 165                            (dmds, res_info) = splitStrictSig sig
 166
 167 cprInfoFromNewStrictness :: StrictSig -> CprInfo
 168 cprInfoFromNewStrictness sig = case strictSigResInfo sig of
 169                                   RetCPR -> ReturnsCPR
 170                                   other  -> NoCPRInfo
 171
 172 newStrictnessFromOld :: Name -> Arity -> Demand.StrictnessInfo -> CprInfo -> StrictSig
 173 newStrictnessFromOld name arity (Demand.StrictnessInfo ds res) cpr
 174   | listLengthCmp ds arity /= GT -- length ds <= arity
 175         -- Sometimes the old strictness analyser has more
 176         -- demands than the arity justifies
 177   = mk_strict_sig name arity $
 178     mkTopDmdType (map newDemand ds) (newRes res cpr)
 179
 180 newStrictnessFromOld name arity other cpr
 181   =     -- Either no strictness info, or arity is too small
 182         -- In either case we can't say anything useful
 183     mk_strict_sig name arity $
 184     mkTopDmdType (replicate arity lazyDmd) (newRes False cpr)
 185
 186 mk_strict_sig name arity dmd_ty
 187   = WARN( arity /= dmdTypeDepth dmd_ty, ppr name <+> (ppr arity $$ ppr dmd_ty) )
 188     mkStrictSig dmd_ty
 189
 190 newRes True  _          = BotRes
 191 newRes False ReturnsCPR = retCPR
 192 newRes False NoCPRInfo  = TopRes
 193
 194 newDemand :: Demand.Demand -> NewDemand.Demand
 195 newDemand (WwLazy True)      = Abs
 196 newDemand (WwLazy False)     = lazyDmd
 197 newDemand WwStrict           = evalDmd
 198 newDemand (WwUnpack unpk ds) = Eval (Prod (map newDemand ds))
 199 newDemand WwPrim             = lazyDmd
 200 newDemand WwEnum             = evalDmd
 201
 202 oldDemand :: NewDemand.Demand -> Demand.Demand
 203 oldDemand Abs              = WwLazy True
 204 oldDemand Top              = WwLazy False
 205 oldDemand Bot              = WwStrict
 206 oldDemand (Box Bot)        = WwStrict
 207 oldDemand (Box Abs)        = WwLazy False
 208 oldDemand (Box (Eval _))   = WwStrict   -- Pass box only
 209 oldDemand (Defer d)        = WwLazy False
 210 oldDemand (Eval (Prod ds)) = WwUnpack True (map oldDemand ds)
 211 oldDemand (Eval (Poly _))  = WwStrict
 212 oldDemand (Call _)         = WwStrict
 213
 214 #endif /* OLD_STRICTNESS */
 215 \end{code}
 216
 217
 218 \begin{code}
 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 FieldLabel      -- The Id for a record selector
 239   | DataConId DataCon           -- The Id for a data constructor *worker*
 240   | DataConWrapId DataCon       -- The Id for a data constructor *wrapper*
 241                                 -- [the only reasons we need to know is so that
 242                                 --  a) we can  suppress printing a definition in the interface file
 243                                 --  b) when typechecking a pattern we can get from the
 244                                 --     Id back to the data con]
 245
 246   | PrimOpId PrimOp             -- The Id for a primitive operator
 247   | FCallId ForeignCall         -- The Id for a foreign call
 248
 249   | NotGlobalId                 -- Used as a convenient extra return value from globalIdDetails
 250
 251 notGlobalId = NotGlobalId
 252
 253 instance Outputable GlobalIdDetails where
 254     ppr NotGlobalId       = ptext SLIT("[***NotGlobalId***]")
 255     ppr VanillaGlobal     = ptext SLIT("[GlobalId]")
 256     ppr (DataConId _)     = ptext SLIT("[DataCon]")
 257     ppr (DataConWrapId _) = ptext SLIT("[DataConWrapper]")
 258     ppr (PrimOpId _)      = ptext SLIT("[PrimOp]")
 259     ppr (FCallId _)       = ptext SLIT("[ForeignCall]")
 260     ppr (RecordSelId _)   = ptext SLIT("[RecSel]")
 261 \end{code}
 262
 263
 264 %************************************************************************
 265 %*                                                                      *
 266 \subsection{The main IdInfo type}
 267 %*                                                                      *
 268 %************************************************************************
 269
 270 An @IdInfo@ gives {\em optional} information about an @Id@.  If
 271 present it never lies, but it may not be present, in which case there
 272 is always a conservative assumption which can be made.
 273
 274 Two @Id@s may have different info even though they have the same
 275 @Unique@ (and are hence the same @Id@); for example, one might lack
 276 the properties attached to the other.
 277
 278 The @IdInfo@ gives information about the value, or definition, of the
 279 @Id@.  It does {\em not} contain information about the @Id@'s usage
 280 (except for @DemandInfo@? ToDo). (@lbvarInfo@ is also a marginal
 281 case.  KSW 1999-04).
 282
 283 \begin{code}
 284 data IdInfo
 285   = IdInfo {
 286         arityInfo       :: !ArityInfo,          -- Its arity
 287         specInfo        :: CoreRules,           -- Specialisations of this function which exist
 288 #ifdef OLD_STRICTNESS
 289         cprInfo         :: CprInfo,             -- Function always constructs a product result
 290         demandInfo      :: Demand.Demand,       -- Whether or not it is definitely demanded
 291         strictnessInfo  :: StrictnessInfo,      -- Strictness properties
 292 #endif
 293         workerInfo      :: WorkerInfo,          -- Pointer to Worker Function
 294         unfoldingInfo   :: Unfolding,           -- Its unfolding
 295         cgInfo          :: CgInfo,              -- Code generator info (arity, CAF info)
 296         lbvarInfo       :: LBVarInfo,           -- Info about a lambda-bound variable
 297         inlinePragInfo  :: InlinePragInfo,      -- Inline pragma
 298         occInfo         :: OccInfo,             -- How it occurs
 299
 300         newStrictnessInfo :: Maybe StrictSig,   -- Reason for Maybe: the DmdAnal phase needs to
 301                                                 -- know whether whether this is the first visit,
 302                                                 -- so it can assign botSig.  Other customers want
 303                                                 -- topSig.  So Nothing is good.
 304
 305         newDemandInfo     :: Maybe Demand       -- Similarly we want to know if there's no
 306                                                 -- known demand yet, for when we are looking for
 307                                                 -- CPR info
 308     }
 309
 310 seqIdInfo :: IdInfo -> ()
 311 seqIdInfo (IdInfo {}) = ()
 312
 313 megaSeqIdInfo :: IdInfo -> ()
 314 megaSeqIdInfo info
 315   = seqRules (specInfo info)                    `seq`
 316     seqWorker (workerInfo info)                 `seq`
 317
 318 -- Omitting this improves runtimes a little, presumably because
 319 -- some unfoldings are not calculated at all
 320 --    seqUnfolding (unfoldingInfo info)         `seq`
 321
 322     seqNewDemandInfo (newDemandInfo info)       `seq`
 323     seqNewStrictnessInfo (newStrictnessInfo info) `seq`
 324
 325 #ifdef OLD_STRICTNESS
 326     Demand.seqDemand (demandInfo info)          `seq`
 327     seqStrictnessInfo (strictnessInfo info)     `seq`
 328     seqCpr (cprInfo info)                       `seq`
 329 #endif
 330
 331 -- CgInfo is involved in a loop, so we have to be careful not to seq it
 332 -- too early.
 333 --    seqCg (cgInfo info)                       `seq`
 334     seqLBVar (lbvarInfo info)           `seq`
 335     seqOccInfo (occInfo info)
 336 \end{code}
 337
 338 Setters
 339
 340 \begin{code}
 341 setWorkerInfo     info wk = wk `seq` info { workerInfo = wk }
 342 setSpecInfo       info sp = sp `seq` info { specInfo = sp }
 343 setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr }
 344 setOccInfo        info oc = oc `seq` info { occInfo = oc }
 345 #ifdef OLD_STRICTNESS
 346 setStrictnessInfo info st = st `seq` info { strictnessInfo = st }
 347 #endif
 348         -- Try to avoid spack leaks by seq'ing
 349
 350 setUnfoldingInfo  info uf
 351   | isEvaldUnfolding uf
 352         -- If the unfolding is a value, the demand info may
 353         -- go pear-shaped, so we nuke it.  Example:
 354         --      let x = (a,b) in
 355         --      case x of (p,q) -> h p q x
 356         -- Here x is certainly demanded. But after we've nuked
 357         -- the case, we'll get just
 358         --      let x = (a,b) in h a b x
 359         -- and now x is not demanded (I'm assuming h is lazy)
 360         -- This really happens.  The solution here is a bit ad hoc...
 361   = info { unfoldingInfo = uf, newDemandInfo = Nothing }
 362
 363   | otherwise
 364         -- We do *not* seq on the unfolding info, For some reason, doing so
 365         -- actually increases residency significantly.
 366   = info { unfoldingInfo = uf }
 367
 368 #ifdef OLD_STRICTNESS
 369 setDemandInfo     info dd = info { demandInfo = dd }
 370 setCprInfo        info cp = info { cprInfo = cp }
 371 #endif
 372
 373 setArityInfo      info ar = info { arityInfo = ar  }
 374 setCgInfo         info cg = info { cgInfo = cg }
 375
 376 setLBVarInfo      info lb = {-lb `seq`-} info { lbvarInfo = lb }
 377
 378 setNewDemandInfo     info dd = dd `seq` info { newDemandInfo = dd }
 379 setNewStrictnessInfo info dd = dd `seq` info { newStrictnessInfo = dd }
 380 \end{code}
 381
 382
 383 \begin{code}
 384 vanillaIdInfo :: IdInfo
 385 vanillaIdInfo
 386   = IdInfo {
 387             cgInfo              = noCgInfo,
 388             arityInfo           = unknownArity,
 389 #ifdef OLD_STRICTNESS
 390             cprInfo             = NoCPRInfo,
 391             demandInfo          = wwLazy,
 392             strictnessInfo      = NoStrictnessInfo,
 393 #endif
 394             specInfo            = emptyCoreRules,
 395             workerInfo          = NoWorker,
 396             unfoldingInfo       = noUnfolding,
 397             lbvarInfo           = NoLBVarInfo,
 398             inlinePragInfo      = AlwaysActive,
 399             occInfo             = NoOccInfo,
 400             newDemandInfo       = Nothing,
 401             newStrictnessInfo   = Nothing
 402            }
 403
 404 hasCafIdInfo = vanillaIdInfo `setCgInfo`    CgInfo MayHaveCafRefs
 405 noCafIdInfo  = vanillaIdInfo `setCgInfo`    CgInfo NoCafRefs
 406         -- Used for built-in type Ids in MkId.
 407         -- These must have a valid CgInfo set, so you can't
 408         --      use vanillaIdInfo!
 409 \end{code}
 410
 411
 412 %************************************************************************
 413 %*                                                                      *
 414 \subsection[arity-IdInfo]{Arity info about an @Id@}
 415 %*                                                                      *
 416 %************************************************************************
 417
 418 For locally-defined Ids, the code generator maintains its own notion
 419 of their arities; so it should not be asking...  (but other things
 420 besides the code-generator need arity info!)
 421
 422 \begin{code}
 423 type ArityInfo = Arity
 424         -- A partial application of this Id to up to n-1 value arguments
 425         -- does essentially no work.  That is not necessarily the
 426         -- same as saying that it has n leading lambdas, because coerces
 427         -- may get in the way.
 428
 429         -- The arity might increase later in the compilation process, if
 430         -- an extra lambda floats up to the binding site.
 431
 432 unknownArity = 0 :: Arity
 433
 434 ppArityInfo 0 = empty
 435 ppArityInfo n = hsep [ptext SLIT("Arity"), int n]
 436 \end{code}
 437
 438 %************************************************************************
 439 %*                                                                      *
 440 \subsection{Inline-pragma information}
 441 %*                                                                      *
 442 %************************************************************************
 443
 444 \begin{code}
 445 type InlinePragInfo = Activation
 446         -- Tells when the inlining is active
 447         -- When it is active the thing may be inlined, depending on how
 448         -- big it is.
 449         --
 450         -- If there was an INLINE pragma, then as a separate matter, the
 451         -- RHS will have been made to look small with a CoreSyn Inline Note
 452 \end{code}
 453
 454
 455 %************************************************************************
 456 %*                                                                      *
 457 \subsection[worker-IdInfo]{Worker info about an @Id@}
 458 %*                                                                      *
 459 %************************************************************************
 460
 461 If this Id has a worker then we store a reference to it. Worker
 462 functions are generated by the worker/wrapper pass.  This uses
 463 information from strictness analysis.
 464
 465 There might not be a worker, even for a strict function, because:
 466 (a) the function might be small enough to inline, so no need
 467     for w/w split
 468 (b) the strictness info might be "SSS" or something, so no w/w split.
 469
 470 Sometimes the arity of a wrapper changes from the original arity from
 471 which it was generated, so we always emit the "original" arity into
 472 the interface file, as part of the worker info.
 473
 474 How can this happen?  Sometimes we get
 475         f = coerce t (\x y -> $wf x y)
 476 at the moment of w/w split; but the eta reducer turns it into
 477         f = coerce t $wf
 478 which is perfectly fine except that the exposed arity so far as
 479 the code generator is concerned (zero) differs from the arity
 480 when we did the split (2).
 481
 482 All this arises because we use 'arity' to mean "exactly how many
 483 top level lambdas are there" in interface files; but during the
 484 compilation of this module it means "how many things can I apply
 485 this to".
 486
 487 \begin{code}
 488
 489 data WorkerInfo = NoWorker
 490                 | HasWorker Id Arity
 491         -- The Arity is the arity of the *wrapper* at the moment of the
 492         -- w/w split. See comments in MkIface.ifaceId, with the 'Worker' code.
 493
 494 seqWorker :: WorkerInfo -> ()
 495 seqWorker (HasWorker id a) = id `seq` a `seq` ()
 496 seqWorker NoWorker         = ()
 497
 498 ppWorkerInfo NoWorker            = empty
 499 ppWorkerInfo (HasWorker wk_id _) = ptext SLIT("__P") <+> ppr wk_id
 500
 501 workerExists :: WorkerInfo -> Bool
 502 workerExists NoWorker        = False
 503 workerExists (HasWorker _ _) = True
 504
 505 workerId :: WorkerInfo -> Id
 506 workerId (HasWorker id _) = id
 507
 508 wrapperArity :: WorkerInfo -> Arity
 509 wrapperArity (HasWorker _ a) = a
 510 \end{code}
 511
 512
 513 %************************************************************************
 514 %*                                                                      *
 515 \subsection[CG-IdInfo]{Code generator-related information}
 516 %*                                                                      *
 517 %************************************************************************
 518
 519 CgInfo encapsulates calling-convention information produced by the code
 520 generator.  It is pasted into the IdInfo of each emitted Id by CoreTidy,
 521 but only as a thunk --- the information is only actually produced further
 522 downstream, by the code generator.
 523
 524 \begin{code}
 525 #ifndef OLD_STRICTNESS
 526 newtype CgInfo = CgInfo CafInfo -- We are back to only having CafRefs in CgInfo
 527 noCgInfo = panic "NoCgInfo!"
 528 #else
 529 data CgInfo = CgInfo CafInfo
 530             | NoCgInfo          -- In debug mode we don't want a black hole here
 531                                 -- See Id.idCgInfo
 532         -- noCgInfo is used for local Ids, which shouldn't need any CgInfo
 533 noCgInfo = NoCgInfo
 534 #endif
 535
 536 cgCafInfo (CgInfo caf_info) = caf_info
 537
 538 setCafInfo info caf_info = info `setCgInfo` CgInfo caf_info
 539
 540 seqCg c = c `seq` ()  -- fields are strict anyhow
 541
 542 vanillaCgInfo = CgInfo MayHaveCafRefs           -- Definitely safe
 543
 544 -- CafInfo is used to build Static Reference Tables (see simplStg/SRT.lhs).
 545
 546 data CafInfo
 547         = MayHaveCafRefs                -- either:
 548                                         -- (1) A function or static constructor
 549                                         --     that refers to one or more CAFs,
 550                                         -- (2) A real live CAF
 551
 552         | NoCafRefs                     -- A function or static constructor
 553                                         -- that refers to no CAFs.
 554
 555 mayHaveCafRefs  MayHaveCafRefs = True
 556 mayHaveCafRefs _               = False
 557
 558 seqCaf c = c `seq` ()
 559
 560 pprCgInfo (CgInfo caf_info) = ppCafInfo caf_info
 561
 562 ppArity 0 = empty
 563 ppArity n = hsep [ptext SLIT("__A"), int n]
 564
 565 ppCafInfo NoCafRefs = ptext SLIT("__C")
 566 ppCafInfo MayHaveCafRefs = empty
 567 \end{code}
 568
 569 \begin{code}
 570 type CgInfoEnv = NameEnv CgInfo
 571
 572 lookupCgInfo :: NameEnv CgInfo -> Name -> CgInfo
 573 lookupCgInfo env n = case lookupNameEnv env n of
 574                         Just info -> info
 575                         Nothing   -> pprTrace "Urk! Not in CgInfo env" (ppr n) vanillaCgInfo
 576 \end{code}
 577
 578
 579 %************************************************************************
 580 %*                                                                      *
 581 \subsection[cpr-IdInfo]{Constructed Product Result info about an @Id@}
 582 %*                                                                      *
 583 %************************************************************************
 584
 585 If the @Id@ is a function then it may have CPR info. A CPR analysis
 586 phase detects whether:
 587
 588 \begin{enumerate}
 589 \item
 590 The function's return value has a product type, i.e. an algebraic  type
 591 with a single constructor. Examples of such types are tuples and boxed
 592 primitive values.
 593 \item
 594 The function always 'constructs' the value that it is returning.  It
 595 must do this on every path through,  and it's OK if it calls another
 596 function which constructs the result.
 597 \end{enumerate}
 598
 599 If this is the case then we store a template which tells us the
 600 function has the CPR property and which components of the result are
 601 also CPRs.
 602
 603 \begin{code}
 604 #ifdef OLD_STRICTNESS
 605 data CprInfo
 606   = NoCPRInfo
 607   | ReturnsCPR  -- Yes, this function returns a constructed product
 608                 -- Implicitly, this means "after the function has been applied
 609                 -- to all its arguments", so the worker/wrapper builder in
 610                 -- WwLib.mkWWcpr checks that that it is indeed saturated before
 611                 -- making use of the CPR info
 612
 613         -- We used to keep nested info about sub-components, but
 614         -- we never used it so I threw it away
 615
 616 seqCpr :: CprInfo -> ()
 617 seqCpr ReturnsCPR = ()
 618 seqCpr NoCPRInfo  = ()
 619
 620 noCprInfo       = NoCPRInfo
 621
 622 ppCprInfo NoCPRInfo  = empty
 623 ppCprInfo ReturnsCPR = ptext SLIT("__M")
 624
 625 instance Outputable CprInfo where
 626     ppr = ppCprInfo
 627
 628 instance Show CprInfo where
 629     showsPrec p c = showsPrecSDoc p (ppr c)
 630 #endif
 631 \end{code}
 632
 633
 634 %************************************************************************
 635 %*                                                                      *
 636 \subsection[lbvar-IdInfo]{Lambda-bound var info about an @Id@}
 637 %*                                                                      *
 638 %************************************************************************
 639
 640 If the @Id@ is a lambda-bound variable then it may have lambda-bound
 641 var info.  The usage analysis (UsageSP) detects whether the lambda
 642 binding this var is a ``one-shot'' lambda; that is, whether it is
 643 applied at most once.
 644
 645 This information may be useful in optimisation, as computations may
 646 safely be floated inside such a lambda without risk of duplicating
 647 work.
 648
 649 \begin{code}
 650 data LBVarInfo
 651   = NoLBVarInfo
 652
 653   | LBVarInfo Type              -- The lambda that binds this Id has this usage
 654                                 --   annotation (i.e., if ==usOnce, then the
 655                                 --   lambda is applied at most once).
 656                                 -- The annotation's kind must be `$'
 657                                 -- HACK ALERT! placing this info here is a short-term hack,
 658                                 --   but it minimises changes to the rest of the compiler.
 659                                 --   Hack agreed by SLPJ/KSW 1999-04.
 660
 661 seqLBVar l = l `seq` ()
 662 \end{code}
 663
 664 \begin{code}
 665 hasNoLBVarInfo NoLBVarInfo = True
 666 hasNoLBVarInfo other       = False
 667
 668 noLBVarInfo = NoLBVarInfo
 669
 670 -- not safe to print or parse LBVarInfo because it is not really a
 671 -- property of the definition, but a property of the context.
 672 pprLBVarInfo NoLBVarInfo     = empty
 673 pprLBVarInfo (LBVarInfo u)   | u `eqUsage` usOnce
 674                              = ptext SLIT("OneShot")
 675                              | otherwise
 676                              = empty
 677
 678 instance Outputable LBVarInfo where
 679     ppr = pprLBVarInfo
 680
 681 instance Show LBVarInfo where
 682     showsPrec p c = showsPrecSDoc p (ppr c)
 683 \end{code}
 684
 685
 686 %************************************************************************
 687 %*                                                                      *
 688 \subsection{Bulk operations on IdInfo}
 689 %*                                                                      *
 690 %************************************************************************
 691
 692 @zapLamInfo@ is used for lambda binders that turn out to to be
 693 part of an unsaturated lambda
 694
 695 \begin{code}
 696 zapLamInfo :: IdInfo -> Maybe IdInfo
 697 zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand})
 698   | is_safe_occ occ && is_safe_dmd demand
 699   = Nothing
 700   | otherwise
 701   = Just (info {occInfo = safe_occ, newDemandInfo = Nothing})
 702   where
 703         -- The "unsafe" occ info is the ones that say I'm not in a lambda
 704         -- because that might not be true for an unsaturated lambda
 705     is_safe_occ (OneOcc in_lam once) = in_lam
 706     is_safe_occ other                = True
 707
 708     safe_occ = case occ of
 709                  OneOcc _ once -> OneOcc insideLam once
 710                  other         -> occ
 711
 712     is_safe_dmd Nothing    = True
 713     is_safe_dmd (Just dmd) = not (isStrictDmd dmd)
 714 \end{code}
 715
 716 \begin{code}
 717 zapDemandInfo :: IdInfo -> Maybe IdInfo
 718 zapDemandInfo info@(IdInfo {newDemandInfo = dmd})
 719   | isJust dmd = Just (info {newDemandInfo = Nothing})
 720   | otherwise  = Nothing
 721 \end{code}
 722
 723
 724 copyIdInfo is used when shorting out a top-level binding
 725         f_local = BIG
 726         f = f_local
 727 where f is exported.  We are going to swizzle it around to
 728         f = BIG
 729         f_local = f
 730
 731 BUT (a) we must be careful about messing up rules
 732     (b) we must ensure f's IdInfo ends up right
 733
 734 (a) Messing up the rules
 735 ~~~~~~~~~~~~~~~~~~~~
 736 The example that went bad on me was this one:
 737
 738     iterate :: (a -> a) -> a -> [a]
 739     iterate = iterateList
 740
 741     iterateFB c f x = x `c` iterateFB c f (f x)
 742     iterateList f x =  x : iterateList f (f x)
 743
 744     {-# RULES
 745     "iterate"   forall f x.     iterate f x = build (\c _n -> iterateFB c f x)
 746     "iterateFB"                 iterateFB (:) = iterateList
 747      #-}
 748
 749 This got shorted out to:
 750
 751     iterateList :: (a -> a) -> a -> [a]
 752     iterateList = iterate
 753
 754     iterateFB c f x = x `c` iterateFB c f (f x)
 755     iterate f x =  x : iterate f (f x)
 756
 757     {-# RULES
 758     "iterate"   forall f x.     iterate f x = build (\c _n -> iterateFB c f x)
 759     "iterateFB"                 iterateFB (:) = iterate
 760      #-}
 761
 762 And now we get an infinite loop in the rule system
 763         iterate f x -> build (\cn -> iterateFB c f x)
 764                     -> iterateFB (:) f x
 765                     -> iterate f x
 766
 767 Tiresome solution: don't do shorting out if f has rewrite rules.
 768 Hence shortableIdInfo.
 769
 770 (b) Keeping the IdInfo right
 771 ~~~~~~~~~~~~~~~~~~~~~~~~
 772 We want to move strictness/worker info from f_local to f, but keep the rest.
 773 Hence copyIdInfo.
 774
 775 \begin{code}
 776 shortableIdInfo :: IdInfo -> Bool
 777 shortableIdInfo info = isEmptyCoreRules (specInfo info)
 778
 779 copyIdInfo :: IdInfo    -- f_local
 780            -> IdInfo    -- f (the exported one)
 781            -> IdInfo    -- New info for f
 782 copyIdInfo f_local f = f { newStrictnessInfo = newStrictnessInfo f_local,
 783 #ifdef OLD_STRICTNESS
 784                            strictnessInfo = strictnessInfo f_local,
 785                            cprInfo        = cprInfo        f_local,
 786 #endif
 787                            workerInfo     = workerInfo     f_local
 788                           }
 789 \end{code}