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