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,
  54
  55         -- Occurrence info
  56         OccInfo(..), isFragileOcc, isDeadOcc, isLoopBreaker,
  57         InsideLam, OneBranch, insideLam, notInsideLam, oneBranch, notOneBranch,
  58         occInfo, setOccInfo,
  59
  60         -- Specialisation
  61         specInfo, setSpecInfo,
  62
  63         -- CG info
  64         CgInfo(..), cgInfo, setCgInfo,  pprCgInfo,
  65         cgArity, cgCafInfo, vanillaCgInfo,
  66         CgInfoEnv, lookupCgInfo,
  67         setCgArity,
  68
  69         -- CAF info
  70         CafInfo(..), ppCafInfo, setCafInfo, mayHaveCafRefs,
  71
  72         -- Constructed Product Result Info
  73         CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo,
  74
  75         -- Lambda-bound variable info
  76         LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo, hasNoLBVarInfo
  77     ) where
  78
  79 #include "HsVersions.h"
  80
  81
  82 import CoreSyn
  83 import Type             ( Type, usOnce, eqUsage )
  84 import PrimOp           ( PrimOp )
  85 import NameEnv          ( NameEnv, lookupNameEnv )
  86 import Name             ( Name )
  87 import Var              ( Id )
  88 import BasicTypes       ( OccInfo(..), isFragileOcc, isDeadOcc, seqOccInfo, isLoopBreaker,
  89                           InsideLam, insideLam, notInsideLam,
  90                           OneBranch, oneBranch, notOneBranch,
  91                           Arity,
  92                           Activation(..)
  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, isStrictDmd,
 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
 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, newDemandInfo = Lazy }
 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      = AlwaysActive,
 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 type InlinePragInfo = Activation
 394         -- Tells when the inlining is active
 395         -- When it is active the thing may be inlined, depending on how
 396         -- big it is.
 397         --
 398         -- If there was an INLINE pragma, then as a separate matter, the
 399         -- RHS will have been made to look small with a CoreSyn Inline Note
 400 \end{code}
 401
 402
 403 %************************************************************************
 404 %*                                                                    *
 405 \subsection[TyGen-IdInfo]{Type generalisation info about an @Id@}
 406 %*                                                                    *
 407 %************************************************************************
 408
 409 Certain passes (notably usage inference) may change the type of an
 410 identifier, modifying all in-scope uses of that identifier
 411 appropriately to maintain type safety.
 412
 413 However, some identifiers must not have their types changed in this
 414 way, because their types are conjured up in the front end of the
 415 compiler rather than being read from the interface file.  Default
 416 methods, dictionary functions, record selectors, and others are in
 417 this category.  (see comment at TcClassDcl.tcClassSig).
 418
 419 To indicate this property, such identifiers are marked TyGenNever.
 420
 421 Furthermore, if the usage inference generates a usage-specialised
 422 variant of a function, we must NOT re-infer a fully-generalised type
 423 at the next inference.  This finer property is indicated by a
 424 TyGenUInfo on the identifier.
 425
 426 \begin{code}
 427 data TyGenInfo
 428   = NoTyGenInfo              -- no restriction on type generalisation
 429
 430   | TyGenUInfo [Maybe Type]  -- restrict generalisation of this Id to
 431                              -- preserve specified usage annotations
 432
 433   | TyGenNever               -- never generalise the type of this Id
 434 \end{code}
 435
 436 For TyGenUInfo, the list has one entry for each usage annotation on
 437 the type of the Id, in left-to-right pre-order (annotations come
 438 before the type they annotate).  Nothing means no restriction; Just
 439 usOnce or Just usMany forces that annotation to that value.  Other
 440 usage annotations are illegal.
 441
 442 \begin{code}
 443 seqTyGenInfo :: TyGenInfo -> ()
 444 seqTyGenInfo  NoTyGenInfo    = ()
 445 seqTyGenInfo (TyGenUInfo us) = seqList us ()
 446 seqTyGenInfo  TyGenNever     = ()
 447
 448 noTyGenInfo :: TyGenInfo
 449 noTyGenInfo = NoTyGenInfo
 450
 451 isNoTyGenInfo :: TyGenInfo -> Bool
 452 isNoTyGenInfo NoTyGenInfo = True
 453 isNoTyGenInfo _           = False
 454
 455 -- NB: There's probably no need to write this information out to the interface file.
 456 -- Why?  Simply because imported identifiers never get their types re-inferred.
 457 -- But it's definitely nice to see in dumps, it for debugging purposes.
 458
 459 ppTyGenInfo :: TyGenInfo -> SDoc
 460 ppTyGenInfo  NoTyGenInfo    = empty
 461 ppTyGenInfo (TyGenUInfo us) = ptext SLIT("__G") <+> text (tyGenInfoString us)
 462 ppTyGenInfo  TyGenNever     = ptext SLIT("__G N")
 463
 464 tyGenInfoString us = map go us
 465   where go  Nothing                      = 'x'  -- for legibility, choose
 466         go (Just u) | u `eqUsage` usOnce = '1'  -- chars with identity
 467                     | u `eqUsage` usMany = 'M'  -- Z-encoding.
 468         go other = pprPanic "IdInfo.tyGenInfoString: unexpected annotation" (ppr other)
 469
 470 instance Outputable TyGenInfo where
 471   ppr = ppTyGenInfo
 472
 473 instance Show TyGenInfo where
 474   showsPrec p c = showsPrecSDoc p (ppr c)
 475 \end{code}
 476
 477
 478 %************************************************************************
 479 %*                                                                      *
 480 \subsection[worker-IdInfo]{Worker info about an @Id@}
 481 %*                                                                      *
 482 %************************************************************************
 483
 484 If this Id has a worker then we store a reference to it. Worker
 485 functions are generated by the worker/wrapper pass.  This uses
 486 information from the strictness and CPR analyses.
 487
 488 There might not be a worker, even for a strict function, because:
 489 (a) the function might be small enough to inline, so no need
 490     for w/w split
 491 (b) the strictness info might be "SSS" or something, so no w/w split.
 492
 493 Sometimes the arity of a wrapper changes from the original arity from
 494 which it was generated, so we always emit the "original" arity into
 495 the interface file, as part of the worker info.
 496
 497 How can this happen?  Sometimes we get
 498         f = coerce t (\x y -> $wf x y)
 499 at the moment of w/w split; but the eta reducer turns it into
 500         f = coerce t $wf
 501 which is perfectly fine except that the exposed arity so far as
 502 the code generator is concerned (zero) differs from the arity
 503 when we did the split (2).
 504
 505 All this arises because we use 'arity' to mean "exactly how many
 506 top level lambdas are there" in interface files; but during the
 507 compilation of this module it means "how many things can I apply
 508 this to".
 509
 510 \begin{code}
 511
 512 data WorkerInfo = NoWorker
 513                 | HasWorker Id Arity
 514         -- The Arity is the arity of the *wrapper* at the moment of the
 515         -- w/w split. See comments in MkIface.ifaceId, with the 'Worker' code.
 516
 517 seqWorker :: WorkerInfo -> ()
 518 seqWorker (HasWorker id _) = id `seq` ()
 519 seqWorker NoWorker         = ()
 520
 521 ppWorkerInfo NoWorker            = empty
 522 ppWorkerInfo (HasWorker wk_id _) = ptext SLIT("__P") <+> ppr wk_id
 523
 524 workerExists :: WorkerInfo -> Bool
 525 workerExists NoWorker        = False
 526 workerExists (HasWorker _ _) = True
 527
 528 workerId :: WorkerInfo -> Id
 529 workerId (HasWorker id _) = id
 530
 531 wrapperArity :: WorkerInfo -> Arity
 532 wrapperArity (HasWorker _ a) = a
 533 \end{code}
 534
 535
 536 %************************************************************************
 537 %*                                                                      *
 538 \subsection[CG-IdInfo]{Code generator-related information}
 539 %*                                                                      *
 540 %************************************************************************
 541
 542 CgInfo encapsulates calling-convention information produced by the code
 543 generator.  It is pasted into the IdInfo of each emitted Id by CoreTidy,
 544 but only as a thunk --- the information is only actually produced further
 545 downstream, by the code generator.
 546
 547 \begin{code}
 548 data CgInfo = CgInfo
 549                 !Arity          -- Exact arity for calling purposes
 550                 !CafInfo
 551 #ifdef DEBUG
 552             | NoCgInfo          -- In debug mode we don't want a black hole here
 553                                 -- See Id.idCgInfo
 554
 555         -- noCgInfo is used for local Ids, which shouldn't need any CgInfo
 556 noCgInfo = NoCgInfo
 557 #else
 558 noCgInfo = panic "NoCgInfo!"
 559 #endif
 560
 561 cgArity   (CgInfo arity _)    = arity
 562 cgCafInfo (CgInfo _ caf_info) = caf_info
 563
 564 setCafInfo info caf_info =
 565   case cgInfo info of { CgInfo arity _  ->
 566         info `setCgInfo` CgInfo arity caf_info }
 567
 568 setCgArity info arity =
 569   case cgInfo info of { CgInfo _ caf_info  ->
 570         info `setCgInfo` CgInfo arity caf_info }
 571
 572 seqCg c = c `seq` ()  -- fields are strict anyhow
 573
 574 vanillaCgInfo = CgInfo 0 MayHaveCafRefs         -- Definitely safe
 575
 576 -- CafInfo is used to build Static Reference Tables (see simplStg/SRT.lhs).
 577
 578 data CafInfo
 579         = MayHaveCafRefs                -- either:
 580                                         -- (1) A function or static constructor
 581                                         --     that refers to one or more CAFs,
 582                                         -- (2) A real live CAF
 583
 584         | NoCafRefs                     -- A function or static constructor
 585                                         -- that refers to no CAFs.
 586
 587 mayHaveCafRefs  MayHaveCafRefs = True
 588 mayHaveCafRefs _               = False
 589
 590 seqCaf c = c `seq` ()
 591
 592 pprCgInfo (CgInfo arity caf_info) = ppArity arity <+> ppCafInfo caf_info
 593
 594 ppArity 0 = empty
 595 ppArity n = hsep [ptext SLIT("__A"), int n]
 596
 597 ppCafInfo NoCafRefs = ptext SLIT("__C")
 598 ppCafInfo MayHaveCafRefs = empty
 599 \end{code}
 600
 601 \begin{code}
 602 type CgInfoEnv = NameEnv CgInfo
 603
 604 lookupCgInfo :: NameEnv CgInfo -> Name -> CgInfo
 605 lookupCgInfo env n = case lookupNameEnv env n of
 606                         Just info -> info
 607                         Nothing   -> pprTrace "Urk! Not in CgInfo env" (ppr n) vanillaCgInfo
 608 \end{code}
 609
 610
 611 %************************************************************************
 612 %*                                                                      *
 613 \subsection[cpr-IdInfo]{Constructed Product Result info about an @Id@}
 614 %*                                                                      *
 615 %************************************************************************
 616
 617 If the @Id@ is a function then it may have CPR info. A CPR analysis
 618 phase detects whether:
 619
 620 \begin{enumerate}
 621 \item
 622 The function's return value has a product type, i.e. an algebraic  type
 623 with a single constructor. Examples of such types are tuples and boxed
 624 primitive values.
 625 \item
 626 The function always 'constructs' the value that it is returning.  It
 627 must do this on every path through,  and it's OK if it calls another
 628 function which constructs the result.
 629 \end{enumerate}
 630
 631 If this is the case then we store a template which tells us the
 632 function has the CPR property and which components of the result are
 633 also CPRs.
 634
 635 \begin{code}
 636 data CprInfo
 637   = NoCPRInfo
 638   | ReturnsCPR  -- Yes, this function returns a constructed product
 639                 -- Implicitly, this means "after the function has been applied
 640                 -- to all its arguments", so the worker/wrapper builder in
 641                 -- WwLib.mkWWcpr checks that that it is indeed saturated before
 642                 -- making use of the CPR info
 643
 644         -- We used to keep nested info about sub-components, but
 645         -- we never used it so I threw it away
 646 \end{code}
 647
 648 \begin{code}
 649 seqCpr :: CprInfo -> ()
 650 seqCpr ReturnsCPR = ()
 651 seqCpr NoCPRInfo  = ()
 652
 653 noCprInfo       = NoCPRInfo
 654
 655 ppCprInfo NoCPRInfo  = empty
 656 ppCprInfo ReturnsCPR = ptext SLIT("__M")
 657
 658 instance Outputable CprInfo where
 659     ppr = ppCprInfo
 660
 661 instance Show CprInfo where
 662     showsPrec p c = showsPrecSDoc p (ppr c)
 663 \end{code}
 664
 665
 666 %************************************************************************
 667 %*                                                                      *
 668 \subsection[lbvar-IdInfo]{Lambda-bound var info about an @Id@}
 669 %*                                                                      *
 670 %************************************************************************
 671
 672 If the @Id@ is a lambda-bound variable then it may have lambda-bound
 673 var info.  The usage analysis (UsageSP) detects whether the lambda
 674 binding this var is a ``one-shot'' lambda; that is, whether it is
 675 applied at most once.
 676
 677 This information may be useful in optimisation, as computations may
 678 safely be floated inside such a lambda without risk of duplicating
 679 work.
 680
 681 \begin{code}
 682 data LBVarInfo
 683   = NoLBVarInfo
 684
 685   | LBVarInfo Type              -- The lambda that binds this Id has this usage
 686                                 --   annotation (i.e., if ==usOnce, then the
 687                                 --   lambda is applied at most once).
 688                                 -- The annotation's kind must be `$'
 689                                 -- HACK ALERT! placing this info here is a short-term hack,
 690                                 --   but it minimises changes to the rest of the compiler.
 691                                 --   Hack agreed by SLPJ/KSW 1999-04.
 692
 693 seqLBVar l = l `seq` ()
 694 \end{code}
 695
 696 \begin{code}
 697 hasNoLBVarInfo NoLBVarInfo = True
 698 hasNoLBVarInfo other       = False
 699
 700 noLBVarInfo = NoLBVarInfo
 701
 702 -- not safe to print or parse LBVarInfo because it is not really a
 703 -- property of the definition, but a property of the context.
 704 pprLBVarInfo NoLBVarInfo     = empty
 705 pprLBVarInfo (LBVarInfo u)   | u `eqUsage` usOnce
 706                              = getPprStyle $ \ sty ->
 707                                if ifaceStyle sty
 708                                then empty
 709                                else ptext SLIT("OneShot")
 710                              | otherwise
 711                              = empty
 712
 713 instance Outputable LBVarInfo where
 714     ppr = pprLBVarInfo
 715
 716 instance Show LBVarInfo where
 717     showsPrec p c = showsPrecSDoc p (ppr c)
 718 \end{code}
 719
 720
 721 %************************************************************************
 722 %*                                                                      *
 723 \subsection{Bulk operations on IdInfo}
 724 %*                                                                      *
 725 %************************************************************************
 726
 727 @zapLamInfo@ is used for lambda binders that turn out to to be
 728 part of an unsaturated lambda
 729
 730 \begin{code}
 731 zapLamInfo :: IdInfo -> Maybe IdInfo
 732 zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand})
 733   | is_safe_occ && not (isStrictDmd demand)
 734   = Nothing
 735   | otherwise
 736   = Just (info {occInfo = safe_occ,
 737                 newDemandInfo = Lazy})
 738   where
 739         -- The "unsafe" occ info is the ones that say I'm not in a lambda
 740         -- because that might not be true for an unsaturated lambda
 741     is_safe_occ = case occ of
 742                         OneOcc in_lam once -> in_lam
 743                         other              -> True
 744
 745     safe_occ = case occ of
 746                  OneOcc _ once -> OneOcc insideLam once
 747                  other         -> occ
 748 \end{code}
 749
 750 \begin{code}
 751 zapDemandInfo :: IdInfo -> Maybe IdInfo
 752 zapDemandInfo info@(IdInfo {newDemandInfo = demand})
 753   | not (isStrictDmd demand) = Nothing
 754   | otherwise                = Just (info {newDemandInfo = Lazy})
 755 \end{code}
 756
 757
 758 copyIdInfo is used when shorting out a top-level binding
 759         f_local = BIG
 760         f = f_local
 761 where f is exported.  We are going to swizzle it around to
 762         f = BIG
 763         f_local = f
 764
 765 BUT (a) we must be careful about messing up rules
 766     (b) we must ensure f's IdInfo ends up right
 767
 768 (a) Messing up the rules
 769 ~~~~~~~~~~~~~~~~~~~~
 770 The example that went bad on me was this one:
 771
 772     iterate :: (a -> a) -> a -> [a]
 773     iterate = iterateList
 774
 775     iterateFB c f x = x `c` iterateFB c f (f x)
 776     iterateList f x =  x : iterateList f (f x)
 777
 778     {-# RULES
 779     "iterate"   forall f x.     iterate f x = build (\c _n -> iterateFB c f x)
 780     "iterateFB"                 iterateFB (:) = iterateList
 781      #-}
 782
 783 This got shorted out to:
 784
 785     iterateList :: (a -> a) -> a -> [a]
 786     iterateList = iterate
 787
 788     iterateFB c f x = x `c` iterateFB c f (f x)
 789     iterate f x =  x : iterate f (f x)
 790
 791     {-# RULES
 792     "iterate"   forall f x.     iterate f x = build (\c _n -> iterateFB c f x)
 793     "iterateFB"                 iterateFB (:) = iterate
 794      #-}
 795
 796 And now we get an infinite loop in the rule system
 797         iterate f x -> build (\cn -> iterateFB c f x)
 798                     -> iterateFB (:) f x
 799                     -> iterate f x
 800
 801 Tiresome solution: don't do shorting out if f has rewrite rules.
 802 Hence shortableIdInfo.
 803
 804 (b) Keeping the IdInfo right
 805 ~~~~~~~~~~~~~~~~~~~~~~~~
 806 We want to move strictness/worker info from f_local to f, but keep the rest.
 807 Hence copyIdInfo.
 808
 809 \begin{code}
 810 shortableIdInfo :: IdInfo -> Bool
 811 shortableIdInfo info = isEmptyCoreRules (specInfo info)
 812
 813 copyIdInfo :: IdInfo    -- f_local
 814            -> IdInfo    -- f (the exported one)
 815            -> IdInfo    -- New info for f
 816 copyIdInfo f_local f = f { strictnessInfo = strictnessInfo f_local,
 817                            workerInfo     = workerInfo     f_local,
 818                            cprInfo        = cprInfo        f_local
 819                           }
 820 \end{code}