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