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