ghc/compiler/basicTypes/IdInfo.lhs

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