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