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