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