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