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