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