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