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