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