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