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