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