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