ghc/compiler/basicTypes/IdInfo.lhs

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