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