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