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