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         -- We do *not* seq on the unfolding info, For some reason, doing so
 355         -- actually increases residency significantly.
 356   = info { unfoldingInfo = uf }
 357
 358 #ifdef OLD_STRICTNESS
 359 setDemandInfo     info dd = info { demandInfo = dd }
 360 setCprInfo        info cp = info { cprInfo = cp }
 361 #endif
 362
 363 setArityInfo      info ar  = info { arityInfo = ar  }
 364 setCafInfo        info caf = info { cafInfo = caf }
 365
 366 setLBVarInfo      info lb = {-lb `seq`-} info { lbvarInfo = lb }
 367
 368 setNewDemandInfo     info dd = dd `seq` info { newDemandInfo = dd }
 369 setNewStrictnessInfo info dd = dd `seq` info { newStrictnessInfo = dd }
 370 \end{code}
 371
 372
 373 \begin{code}
 374 vanillaIdInfo :: IdInfo
 375 vanillaIdInfo
 376   = IdInfo {
 377             cafInfo             = vanillaCafInfo,
 378             arityInfo           = unknownArity,
 379 #ifdef OLD_STRICTNESS
 380             cprInfo             = NoCPRInfo,
 381             demandInfo          = wwLazy,
 382             strictnessInfo      = NoStrictnessInfo,
 383 #endif
 384             specInfo            = emptyCoreRules,
 385             workerInfo          = NoWorker,
 386             unfoldingInfo       = noUnfolding,
 387             lbvarInfo           = NoLBVarInfo,
 388             inlinePragInfo      = AlwaysActive,
 389             occInfo             = NoOccInfo,
 390             newDemandInfo       = Nothing,
 391             newStrictnessInfo   = Nothing
 392            }
 393
 394 noCafIdInfo  = vanillaIdInfo `setCafInfo`    NoCafRefs
 395         -- Used for built-in type Ids in MkId.
 396 \end{code}
 397
 398
 399 %************************************************************************
 400 %*                                                                      *
 401 \subsection[arity-IdInfo]{Arity info about an @Id@}
 402 %*                                                                      *
 403 %************************************************************************
 404
 405 For locally-defined Ids, the code generator maintains its own notion
 406 of their arities; so it should not be asking...  (but other things
 407 besides the code-generator need arity info!)
 408
 409 \begin{code}
 410 type ArityInfo = Arity
 411         -- A partial application of this Id to up to n-1 value arguments
 412         -- does essentially no work.  That is not necessarily the
 413         -- same as saying that it has n leading lambdas, because coerces
 414         -- may get in the way.
 415
 416         -- The arity might increase later in the compilation process, if
 417         -- an extra lambda floats up to the binding site.
 418
 419 unknownArity = 0 :: Arity
 420
 421 ppArityInfo 0 = empty
 422 ppArityInfo n = hsep [ptext SLIT("Arity"), int n]
 423 \end{code}
 424
 425 %************************************************************************
 426 %*                                                                      *
 427 \subsection{Inline-pragma information}
 428 %*                                                                      *
 429 %************************************************************************
 430
 431 \begin{code}
 432 type InlinePragInfo = Activation
 433         -- Tells when the inlining is active
 434         -- When it is active the thing may be inlined, depending on how
 435         -- big it is.
 436         --
 437         -- If there was an INLINE pragma, then as a separate matter, the
 438         -- RHS will have been made to look small with a CoreSyn Inline Note
 439 \end{code}
 440
 441
 442 %************************************************************************
 443 %*                                                                      *
 444 \subsection[worker-IdInfo]{Worker info about an @Id@}
 445 %*                                                                      *
 446 %************************************************************************
 447
 448 If this Id has a worker then we store a reference to it. Worker
 449 functions are generated by the worker/wrapper pass.  This uses
 450 information from strictness analysis.
 451
 452 There might not be a worker, even for a strict function, because:
 453 (a) the function might be small enough to inline, so no need
 454     for w/w split
 455 (b) the strictness info might be "SSS" or something, so no w/w split.
 456
 457 Sometimes the arity of a wrapper changes from the original arity from
 458 which it was generated, so we always emit the "original" arity into
 459 the interface file, as part of the worker info.
 460
 461 How can this happen?  Sometimes we get
 462         f = coerce t (\x y -> $wf x y)
 463 at the moment of w/w split; but the eta reducer turns it into
 464         f = coerce t $wf
 465 which is perfectly fine except that the exposed arity so far as
 466 the code generator is concerned (zero) differs from the arity
 467 when we did the split (2).
 468
 469 All this arises because we use 'arity' to mean "exactly how many
 470 top level lambdas are there" in interface files; but during the
 471 compilation of this module it means "how many things can I apply
 472 this to".
 473
 474 \begin{code}
 475
 476 data WorkerInfo = NoWorker
 477                 | HasWorker Id Arity
 478         -- The Arity is the arity of the *wrapper* at the moment of the
 479         -- w/w split. See comments in MkIface.ifaceId, with the 'Worker' code.
 480
 481 seqWorker :: WorkerInfo -> ()
 482 seqWorker (HasWorker id a) = id `seq` a `seq` ()
 483 seqWorker NoWorker         = ()
 484
 485 ppWorkerInfo NoWorker            = empty
 486 ppWorkerInfo (HasWorker wk_id _) = ptext SLIT("__P") <+> ppr wk_id
 487
 488 workerExists :: WorkerInfo -> Bool
 489 workerExists NoWorker        = False
 490 workerExists (HasWorker _ _) = True
 491
 492 workerId :: WorkerInfo -> Id
 493 workerId (HasWorker id _) = id
 494
 495 wrapperArity :: WorkerInfo -> Arity
 496 wrapperArity (HasWorker _ a) = a
 497 \end{code}
 498
 499
 500 %************************************************************************
 501 %*                                                                      *
 502 \subsection[CG-IdInfo]{Code generator-related information}
 503 %*                                                                      *
 504 %************************************************************************
 505
 506 \begin{code}
 507 -- CafInfo is used to build Static Reference Tables (see simplStg/SRT.lhs).
 508
 509 data CafInfo
 510         = MayHaveCafRefs                -- either:
 511                                         -- (1) A function or static constructor
 512                                         --     that refers to one or more CAFs,
 513                                         -- (2) A real live CAF
 514
 515         | NoCafRefs                     -- A function or static constructor
 516                                         -- that refers to no CAFs.
 517
 518 vanillaCafInfo = MayHaveCafRefs         -- Definitely safe
 519
 520 mayHaveCafRefs  MayHaveCafRefs = True
 521 mayHaveCafRefs _               = False
 522
 523 seqCaf c = c `seq` ()
 524
 525 ppCafInfo NoCafRefs = ptext SLIT("NoCafRefs")
 526 ppCafInfo MayHaveCafRefs = empty
 527 \end{code}
 528
 529 %************************************************************************
 530 %*                                                                      *
 531 \subsection[cpr-IdInfo]{Constructed Product Result info about an @Id@}
 532 %*                                                                      *
 533 %************************************************************************
 534
 535 If the @Id@ is a function then it may have CPR info. A CPR analysis
 536 phase detects whether:
 537
 538 \begin{enumerate}
 539 \item
 540 The function's return value has a product type, i.e. an algebraic  type
 541 with a single constructor. Examples of such types are tuples and boxed
 542 primitive values.
 543 \item
 544 The function always 'constructs' the value that it is returning.  It
 545 must do this on every path through,  and it's OK if it calls another
 546 function which constructs the result.
 547 \end{enumerate}
 548
 549 If this is the case then we store a template which tells us the
 550 function has the CPR property and which components of the result are
 551 also CPRs.
 552
 553 \begin{code}
 554 #ifdef OLD_STRICTNESS
 555 data CprInfo
 556   = NoCPRInfo
 557   | ReturnsCPR  -- Yes, this function returns a constructed product
 558                 -- Implicitly, this means "after the function has been applied
 559                 -- to all its arguments", so the worker/wrapper builder in
 560                 -- WwLib.mkWWcpr checks that that it is indeed saturated before
 561                 -- making use of the CPR info
 562
 563         -- We used to keep nested info about sub-components, but
 564         -- we never used it so I threw it away
 565
 566 seqCpr :: CprInfo -> ()
 567 seqCpr ReturnsCPR = ()
 568 seqCpr NoCPRInfo  = ()
 569
 570 noCprInfo       = NoCPRInfo
 571
 572 ppCprInfo NoCPRInfo  = empty
 573 ppCprInfo ReturnsCPR = ptext SLIT("__M")
 574
 575 instance Outputable CprInfo where
 576     ppr = ppCprInfo
 577
 578 instance Show CprInfo where
 579     showsPrec p c = showsPrecSDoc p (ppr c)
 580 #endif
 581 \end{code}
 582
 583
 584 %************************************************************************
 585 %*                                                                      *
 586 \subsection[lbvar-IdInfo]{Lambda-bound var info about an @Id@}
 587 %*                                                                      *
 588 %************************************************************************
 589
 590 If the @Id@ is a lambda-bound variable then it may have lambda-bound
 591 var info.  Sometimes we know whether the lambda binding this var is a
 592 ``one-shot'' lambda; that is, whether it is applied at most once.
 593
 594 This information may be useful in optimisation, as computations may
 595 safely be floated inside such a lambda without risk of duplicating
 596 work.
 597
 598 \begin{code}
 599 data LBVarInfo = NoLBVarInfo
 600                | IsOneShotLambda        -- The lambda is applied at most once).
 601
 602 seqLBVar l = l `seq` ()
 603 \end{code}
 604
 605 \begin{code}
 606 hasNoLBVarInfo NoLBVarInfo     = True
 607 hasNoLBVarInfo IsOneShotLambda = False
 608
 609 noLBVarInfo = NoLBVarInfo
 610
 611 pprLBVarInfo NoLBVarInfo     = empty
 612 pprLBVarInfo IsOneShotLambda = ptext SLIT("OneShot")
 613
 614 instance Outputable LBVarInfo where
 615     ppr = pprLBVarInfo
 616
 617 instance Show LBVarInfo where
 618     showsPrec p c = showsPrecSDoc p (ppr c)
 619 \end{code}
 620
 621
 622 %************************************************************************
 623 %*                                                                      *
 624 \subsection{Bulk operations on IdInfo}
 625 %*                                                                      *
 626 %************************************************************************
 627
 628 @zapLamInfo@ is used for lambda binders that turn out to to be
 629 part of an unsaturated lambda
 630
 631 \begin{code}
 632 zapLamInfo :: IdInfo -> Maybe IdInfo
 633 zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand})
 634   | is_safe_occ occ && is_safe_dmd demand
 635   = Nothing
 636   | otherwise
 637   = Just (info {occInfo = safe_occ, newDemandInfo = Nothing})
 638   where
 639         -- The "unsafe" occ info is the ones that say I'm not in a lambda
 640         -- because that might not be true for an unsaturated lambda
 641     is_safe_occ (OneOcc in_lam once) = in_lam
 642     is_safe_occ other                = True
 643
 644     safe_occ = case occ of
 645                  OneOcc _ once -> OneOcc insideLam once
 646                  other         -> occ
 647
 648     is_safe_dmd Nothing    = True
 649     is_safe_dmd (Just dmd) = not (isStrictDmd dmd)
 650 \end{code}
 651
 652 \begin{code}
 653 zapDemandInfo :: IdInfo -> Maybe IdInfo
 654 zapDemandInfo info@(IdInfo {newDemandInfo = dmd})
 655   | isJust dmd = Just (info {newDemandInfo = Nothing})
 656   | otherwise  = Nothing
 657 \end{code}
 658
 659
 660 copyIdInfo is used when shorting out a top-level binding
 661         f_local = BIG
 662         f = f_local
 663 where f is exported.  We are going to swizzle it around to
 664         f = BIG
 665         f_local = f
 666
 667 BUT (a) we must be careful about messing up rules
 668     (b) we must ensure f's IdInfo ends up right
 669
 670 (a) Messing up the rules
 671 ~~~~~~~~~~~~~~~~~~~~
 672 The example that went bad on me was this one:
 673
 674     iterate :: (a -> a) -> a -> [a]
 675     iterate = iterateList
 676
 677     iterateFB c f x = x `c` iterateFB c f (f x)
 678     iterateList f x =  x : iterateList f (f x)
 679
 680     {-# RULES
 681     "iterate"   forall f x.     iterate f x = build (\c _n -> iterateFB c f x)
 682     "iterateFB"                 iterateFB (:) = iterateList
 683      #-}
 684
 685 This got shorted out to:
 686
 687     iterateList :: (a -> a) -> a -> [a]
 688     iterateList = iterate
 689
 690     iterateFB c f x = x `c` iterateFB c f (f x)
 691     iterate f x =  x : iterate f (f x)
 692
 693     {-# RULES
 694     "iterate"   forall f x.     iterate f x = build (\c _n -> iterateFB c f x)
 695     "iterateFB"                 iterateFB (:) = iterate
 696      #-}
 697
 698 And now we get an infinite loop in the rule system
 699         iterate f x -> build (\cn -> iterateFB c f x)
 700                     -> iterateFB (:) f x
 701                     -> iterate f x
 702
 703 Tiresome solution: don't do shorting out if f has rewrite rules.
 704 Hence shortableIdInfo.
 705
 706 (b) Keeping the IdInfo right
 707 ~~~~~~~~~~~~~~~~~~~~~~~~
 708 We want to move strictness/worker info from f_local to f, but keep the rest.
 709 Hence copyIdInfo.
 710
 711 \begin{code}
 712 shortableIdInfo :: IdInfo -> Bool
 713 shortableIdInfo info = isEmptyCoreRules (specInfo info)
 714
 715 copyIdInfo :: IdInfo    -- f_local
 716            -> IdInfo    -- f (the exported one)
 717            -> IdInfo    -- New info for f
 718 copyIdInfo f_local f = f { newStrictnessInfo = newStrictnessInfo f_local,
 719 #ifdef OLD_STRICTNESS
 720                            strictnessInfo = strictnessInfo f_local,
 721                            cprInfo        = cprInfo        f_local,
 722 #endif
 723                            workerInfo     = workerInfo     f_local
 724                           }
 725 \end{code}