compiler/basicTypes/IdInfo.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
   4 %
   5 \section[IdInfo]{@IdInfos@: Non-essential information about @Ids@}
   6
   7 (And a pretty good illustration of quite a few things wrong with
   8 Haskell. [WDP 94/11])
   9
  10 \begin{code}
  11 module IdInfo (
  12         -- * The GlobalIdDetails type
  13         GlobalIdDetails(..), notGlobalId,       -- Not abstract
  14
  15         -- * The IdInfo type
  16         IdInfo,         -- Abstract
  17         vanillaIdInfo, noCafIdInfo,
  18         seqIdInfo, megaSeqIdInfo,
  19
  20         -- ** Zapping various forms of Info
  21         zapLamInfo, zapDemandInfo, zapFragileInfo,
  22
  23         -- ** The ArityInfo type
  24         ArityInfo,
  25         unknownArity,
  26         arityInfo, setArityInfo, ppArityInfo,
  27
  28         -- ** Demand and strictness Info
  29         newStrictnessInfo, setNewStrictnessInfo,
  30         newDemandInfo, setNewDemandInfo, pprNewStrictness,
  31         setAllStrictnessInfo,
  32
  33 #ifdef OLD_STRICTNESS
  34         -- ** Old strictness Info
  35         StrictnessInfo(..),
  36         mkStrictnessInfo, noStrictnessInfo,
  37         ppStrictnessInfo, isBottomingStrictness,
  38         strictnessInfo, setStrictnessInfo,
  39
  40         oldStrictnessFromNew, newStrictnessFromOld,
  41
  42         -- ** Old demand Info
  43         demandInfo, setDemandInfo,
  44         oldDemand, newDemand,
  45
  46         -- ** Old Constructed Product Result Info
  47         CprInfo(..),
  48         cprInfo, setCprInfo, ppCprInfo, noCprInfo,
  49         cprInfoFromNewStrictness,
  50 #endif
  51
  52         -- ** The WorkerInfo type
  53         WorkerInfo(..),
  54         workerExists, wrapperArity, workerId,
  55         workerInfo, setWorkerInfo, ppWorkerInfo,
  56
  57         -- ** Unfolding Info
  58         unfoldingInfo, setUnfoldingInfo, setUnfoldingInfoLazily,
  59
  60         -- ** The InlinePragInfo type
  61         InlinePragInfo,
  62         inlinePragInfo, setInlinePragInfo,
  63
  64         -- ** The OccInfo type
  65         OccInfo(..),
  66         isFragileOcc, isDeadOcc, isLoopBreaker,
  67         occInfo, setOccInfo,
  68
  69         InsideLam, OneBranch,
  70         insideLam, notInsideLam, oneBranch, notOneBranch,
  71
  72         -- ** The SpecInfo type
  73         SpecInfo(..),
  74         isEmptySpecInfo, specInfoFreeVars,
  75         specInfoRules, seqSpecInfo, setSpecInfoHead,
  76         specInfo, setSpecInfo,
  77
  78         -- ** The CAFInfo type
  79         CafInfo(..),
  80         ppCafInfo, mayHaveCafRefs,
  81         cafInfo, setCafInfo,
  82
  83         -- ** The LBVarInfo type
  84         LBVarInfo(..),
  85         noLBVarInfo, hasNoLBVarInfo,
  86         lbvarInfo, setLBVarInfo,
  87
  88         -- ** Tick-box Info
  89         TickBoxOp(..), TickBoxId,
  90     ) where
  91
  92 import CoreSyn ( CoreRule, setRuleIdName, seqRules, Unfolding, noUnfolding )
  93
  94 import Class
  95 import PrimOp
  96 import Name
  97 import Var
  98 import VarSet
  99 import BasicTypes
 100 import DataCon
 101 import TyCon
 102 import ForeignCall
 103 import NewDemand
 104 import Outputable
 105 import Module
 106 import FastString
 107
 108 import Data.Maybe
 109
 110 #ifdef OLD_STRICTNESS
 111 import Demand
 112 import qualified Demand
 113 import Util
 114 import Data.List
 115 #endif
 116
 117 -- infixl so you can say (id `set` a `set` b)
 118 infixl  1 `setSpecInfo`,
 119           `setArityInfo`,
 120           `setInlinePragInfo`,
 121           `setUnfoldingInfo`,
 122           `setWorkerInfo`,
 123           `setLBVarInfo`,
 124           `setOccInfo`,
 125           `setCafInfo`,
 126           `setNewStrictnessInfo`,
 127           `setAllStrictnessInfo`,
 128           `setNewDemandInfo`
 129 #ifdef OLD_STRICTNESS
 130           , `setCprInfo`
 131           , `setDemandInfo`
 132           , `setStrictnessInfo`
 133 #endif
 134 \end{code}
 135
 136 %************************************************************************
 137 %*                                                                      *
 138 \subsection{New strictness info}
 139 %*                                                                      *
 140 %************************************************************************
 141
 142 To be removed later
 143
 144 \begin{code}
 145 -- | Set old and new strictness information together
 146 setAllStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo
 147 setAllStrictnessInfo info Nothing
 148   = info { newStrictnessInfo = Nothing
 149 #ifdef OLD_STRICTNESS
 150          , strictnessInfo = NoStrictnessInfo
 151          , cprInfo = NoCPRInfo
 152 #endif
 153          }
 154
 155 setAllStrictnessInfo info (Just sig)
 156   = info { newStrictnessInfo = Just sig
 157 #ifdef OLD_STRICTNESS
 158          , strictnessInfo = oldStrictnessFromNew sig
 159          , cprInfo = cprInfoFromNewStrictness sig
 160 #endif
 161          }
 162
 163 seqNewStrictnessInfo :: Maybe StrictSig -> ()
 164 seqNewStrictnessInfo Nothing = ()
 165 seqNewStrictnessInfo (Just ty) = seqStrictSig ty
 166
 167 pprNewStrictness :: Maybe StrictSig -> SDoc
 168 pprNewStrictness Nothing = empty
 169 pprNewStrictness (Just sig) = ftext (fsLit "Str:") <+> ppr sig
 170
 171 #ifdef OLD_STRICTNESS
 172 oldStrictnessFromNew :: StrictSig -> Demand.StrictnessInfo
 173 oldStrictnessFromNew sig = mkStrictnessInfo (map oldDemand dmds, isBotRes res_info)
 174                          where
 175                            (dmds, res_info) = splitStrictSig sig
 176
 177 cprInfoFromNewStrictness :: StrictSig -> CprInfo
 178 cprInfoFromNewStrictness sig = case strictSigResInfo sig of
 179                                   RetCPR -> ReturnsCPR
 180                                   other  -> NoCPRInfo
 181
 182 newStrictnessFromOld :: Name -> Arity -> Demand.StrictnessInfo -> CprInfo -> StrictSig
 183 newStrictnessFromOld name arity (Demand.StrictnessInfo ds res) cpr
 184   | listLengthCmp ds arity /= GT -- length ds <= arity
 185         -- Sometimes the old strictness analyser has more
 186         -- demands than the arity justifies
 187   = mk_strict_sig name arity $
 188     mkTopDmdType (map newDemand ds) (newRes res cpr)
 189
 190 newStrictnessFromOld name arity other cpr
 191   =     -- Either no strictness info, or arity is too small
 192         -- In either case we can't say anything useful
 193     mk_strict_sig name arity $
 194     mkTopDmdType (replicate arity lazyDmd) (newRes False cpr)
 195
 196 mk_strict_sig name arity dmd_ty
 197   = WARN( arity /= dmdTypeDepth dmd_ty, ppr name <+> (ppr arity $$ ppr dmd_ty) )
 198     mkStrictSig dmd_ty
 199
 200 newRes True  _          = BotRes
 201 newRes False ReturnsCPR = retCPR
 202 newRes False NoCPRInfo  = TopRes
 203
 204 newDemand :: Demand.Demand -> NewDemand.Demand
 205 newDemand (WwLazy True)      = Abs
 206 newDemand (WwLazy False)     = lazyDmd
 207 newDemand WwStrict           = evalDmd
 208 newDemand (WwUnpack unpk ds) = Eval (Prod (map newDemand ds))
 209 newDemand WwPrim             = lazyDmd
 210 newDemand WwEnum             = evalDmd
 211
 212 oldDemand :: NewDemand.Demand -> Demand.Demand
 213 oldDemand Abs              = WwLazy True
 214 oldDemand Top              = WwLazy False
 215 oldDemand Bot              = WwStrict
 216 oldDemand (Box Bot)        = WwStrict
 217 oldDemand (Box Abs)        = WwLazy False
 218 oldDemand (Box (Eval _))   = WwStrict   -- Pass box only
 219 oldDemand (Defer d)        = WwLazy False
 220 oldDemand (Eval (Prod ds)) = WwUnpack True (map oldDemand ds)
 221 oldDemand (Eval (Poly _))  = WwStrict
 222 oldDemand (Call _)         = WwStrict
 223
 224 #endif /* OLD_STRICTNESS */
 225 \end{code}
 226
 227
 228 \begin{code}
 229 seqNewDemandInfo :: Maybe Demand -> ()
 230 seqNewDemandInfo Nothing    = ()
 231 seqNewDemandInfo (Just dmd) = seqDemand dmd
 232 \end{code}
 233
 234
 235 %************************************************************************
 236 %*                                                                      *
 237 \subsection{GlobalIdDetails}
 238 %*                                                                      *
 239 %************************************************************************
 240
 241 This type is here (rather than in Id.lhs) mainly because there's
 242 an IdInfo.hi-boot, but no Id.hi-boot, and GlobalIdDetails is imported
 243 (recursively) by Var.lhs.
 244
 245 \begin{code}
 246 -- | Information pertaining to global 'Id's. See "Var#globalvslocal" for the distinction
 247 -- between global and local in this context
 248 data GlobalIdDetails
 249   = VanillaGlobal               -- ^ The 'Id' is imported from elsewhere or is a default method 'Id'
 250
 251   -- | The 'Id' for a record selector
 252   | RecordSelId
 253     { sel_tycon   :: TyCon      -- ^ For a data type family, this is the /instance/ 'TyCon'
 254                                 --   not the family 'TyCon'
 255     , sel_label   :: FieldLabel
 256     , sel_naughty :: Bool       -- True <=> a "naughty" selector which can't actually exist, for example @x@ in:
 257                                 --
 258                                 -- > data T = forall a. MkT { x :: a }
 259     }
 260                                 -- See Note [Naughty record selectors]
 261                                 -- with MkId.mkRecordSelectorId
 262
 263   | DataConWorkId DataCon       -- ^ The 'Id' is for a data constructor /worker/
 264   | DataConWrapId DataCon       -- ^ The 'Id' is for a data constructor /wrapper/
 265
 266                                 -- [the only reasons we need to know is so that
 267                                 --  a) to support isImplicitId
 268                                 --  b) when desugaring a RecordCon we can get
 269                                 --     from the Id back to the data con]
 270
 271   | ClassOpId Class             -- ^ The 'Id' is an operation of a class
 272
 273   | PrimOpId PrimOp             -- ^ The 'Id' is for a primitive operator
 274   | FCallId ForeignCall         -- ^ The 'Id' is for a foreign call
 275
 276   | TickBoxOpId TickBoxOp       -- ^ The 'Id' is for a HPC tick box (both traditional and binary)
 277
 278   | NotGlobalId                 -- ^ Used as a convenient extra return value from 'globalIdDetails'
 279
 280 -- | An entirely unhelpful 'GlobalIdDetails'
 281 notGlobalId :: GlobalIdDetails
 282 notGlobalId = NotGlobalId
 283
 284 instance Outputable GlobalIdDetails where
 285     ppr NotGlobalId       = ptext (sLit "[***NotGlobalId***]")
 286     ppr VanillaGlobal     = ptext (sLit "[GlobalId]")
 287     ppr (DataConWorkId _) = ptext (sLit "[DataCon]")
 288     ppr (DataConWrapId _) = ptext (sLit "[DataConWrapper]")
 289     ppr (ClassOpId _)     = ptext (sLit "[ClassOp]")
 290     ppr (PrimOpId _)      = ptext (sLit "[PrimOp]")
 291     ppr (FCallId _)       = ptext (sLit "[ForeignCall]")
 292     ppr (TickBoxOpId _)   = ptext (sLit "[TickBoxOp]")
 293     ppr (RecordSelId {})  = ptext (sLit "[RecSel]")
 294 \end{code}
 295
 296
 297 %************************************************************************
 298 %*                                                                      *
 299 \subsection{The main IdInfo type}
 300 %*                                                                      *
 301 %************************************************************************
 302
 303 \begin{code}
 304 -- | An 'IdInfo' gives /optional/ information about an 'Id'.  If
 305 -- present it never lies, but it may not be present, in which case there
 306 -- is always a conservative assumption which can be made.
 307 --
 308 -- Two 'Id's may have different info even though they have the same
 309 -- 'Unique' (and are hence the same 'Id'); for example, one might lack
 310 -- the properties attached to the other.
 311 --
 312 -- The 'IdInfo' gives information about the value, or definition, of the
 313 -- 'Id'.  It does not contain information about the 'Id''s usage,
 314 -- except for 'demandInfo' and 'lbvarInfo'.
 315 data IdInfo
 316   = IdInfo {
 317         arityInfo       :: !ArityInfo,          -- ^ 'Id' arity
 318         specInfo        :: SpecInfo,            -- ^ Specialisations of the 'Id's function which exist
 319 #ifdef OLD_STRICTNESS
 320         cprInfo         :: CprInfo,             -- ^ If the 'Id's function always constructs a product result
 321         demandInfo      :: Demand.Demand,       -- ^ Whether or not the 'Id' is definitely demanded
 322         strictnessInfo  :: StrictnessInfo,      -- ^ 'Id' strictness properties
 323 #endif
 324         workerInfo      :: WorkerInfo,          -- ^ Pointer to worker function.
 325                                                 -- Within one module this is irrelevant; the
 326                                                 -- inlining of a worker is handled via the 'Unfolding'.
 327                                                 -- However, when the module is imported by others, the
 328                                                 -- 'WorkerInfo' is used /only/ to indicate the form of
 329                                                 -- the RHS, so that interface files don't actually
 330                                                 -- need to contain the RHS; it can be derived from
 331                                                 -- the strictness info
 332
 333         unfoldingInfo   :: Unfolding,           -- ^ The 'Id's unfolding
 334         cafInfo         :: CafInfo,             -- ^ 'Id' CAF info
 335         lbvarInfo       :: LBVarInfo,           -- ^ Info about a lambda-bound variable, if the 'Id' is one
 336         inlinePragInfo  :: InlinePragInfo,      -- ^ Any inline pragma atached to the 'Id'
 337         occInfo         :: OccInfo,             -- ^ How the 'Id' occurs in the program
 338
 339         newStrictnessInfo :: Maybe StrictSig,   -- ^ Id strictness information. Reason for Maybe:
 340                                                 -- the DmdAnal phase needs to know whether
 341                                                 -- this is the first visit, so it can assign botSig.
 342                                                 -- Other customers want topSig.  So @Nothing@ is good.
 343
 344         newDemandInfo     :: Maybe Demand       -- ^ Id demand information. Similarly we want to know
 345                                                 -- if there's no known demand yet, for when we are looking
 346                                                 -- for CPR info
 347     }
 348
 349 -- | Just evaluate the 'IdInfo' to WHNF
 350 seqIdInfo :: IdInfo -> ()
 351 seqIdInfo (IdInfo {}) = ()
 352
 353 -- | Evaluate all the fields of the 'IdInfo' that are generally demanded by the
 354 -- compiler
 355 megaSeqIdInfo :: IdInfo -> ()
 356 megaSeqIdInfo info
 357   = seqSpecInfo (specInfo info)                 `seq`
 358     seqWorker (workerInfo info)                 `seq`
 359
 360 -- Omitting this improves runtimes a little, presumably because
 361 -- some unfoldings are not calculated at all
 362 --    seqUnfolding (unfoldingInfo info)         `seq`
 363
 364     seqNewDemandInfo (newDemandInfo info)       `seq`
 365     seqNewStrictnessInfo (newStrictnessInfo info) `seq`
 366
 367 #ifdef OLD_STRICTNESS
 368     Demand.seqDemand (demandInfo info)          `seq`
 369     seqStrictnessInfo (strictnessInfo info)     `seq`
 370     seqCpr (cprInfo info)                       `seq`
 371 #endif
 372
 373     seqCaf (cafInfo info)                       `seq`
 374     seqLBVar (lbvarInfo info)                   `seq`
 375     seqOccInfo (occInfo info)
 376 \end{code}
 377
 378 Setters
 379
 380 \begin{code}
 381 setWorkerInfo :: IdInfo -> WorkerInfo -> IdInfo
 382 setWorkerInfo     info wk = wk `seq` info { workerInfo = wk }
 383 setSpecInfo :: IdInfo -> SpecInfo -> IdInfo
 384 setSpecInfo       info sp = sp `seq` info { specInfo = sp }
 385 setInlinePragInfo :: IdInfo -> InlinePragInfo -> IdInfo
 386 setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr }
 387 setOccInfo :: IdInfo -> OccInfo -> IdInfo
 388 setOccInfo        info oc = oc `seq` info { occInfo = oc }
 389 #ifdef OLD_STRICTNESS
 390 setStrictnessInfo info st = st `seq` info { strictnessInfo = st }
 391 #endif
 392         -- Try to avoid spack leaks by seq'ing
 393
 394 setUnfoldingInfoLazily :: IdInfo -> Unfolding -> IdInfo
 395 setUnfoldingInfoLazily info uf  -- Lazy variant to avoid looking at the
 396   =                             -- unfolding of an imported Id unless necessary
 397     info { unfoldingInfo = uf } -- (In this case the demand-zapping is redundant.)
 398
 399 setUnfoldingInfo :: IdInfo -> Unfolding -> IdInfo
 400 setUnfoldingInfo info uf
 401         -- We do *not* seq on the unfolding info, For some reason, doing so
 402         -- actually increases residency significantly.
 403   = info { unfoldingInfo = uf }
 404
 405 #ifdef OLD_STRICTNESS
 406 setDemandInfo     info dd = info { demandInfo = dd }
 407 setCprInfo        info cp = info { cprInfo = cp }
 408 #endif
 409
 410 setArityInfo :: IdInfo -> ArityInfo -> IdInfo
 411 setArityInfo      info ar  = info { arityInfo = ar  }
 412 setCafInfo :: IdInfo -> CafInfo -> IdInfo
 413 setCafInfo        info caf = info { cafInfo = caf }
 414
 415 setLBVarInfo :: IdInfo -> LBVarInfo -> IdInfo
 416 setLBVarInfo      info lb = {-lb `seq`-} info { lbvarInfo = lb }
 417
 418 setNewDemandInfo :: IdInfo -> Maybe Demand -> IdInfo
 419 setNewDemandInfo     info dd = dd `seq` info { newDemandInfo = dd }
 420 setNewStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo
 421 setNewStrictnessInfo info dd = dd `seq` info { newStrictnessInfo = dd }
 422 \end{code}
 423
 424
 425 \begin{code}
 426 -- | Basic 'IdInfo' that carries no useful information whatsoever
 427 vanillaIdInfo :: IdInfo
 428 vanillaIdInfo
 429   = IdInfo {
 430             cafInfo             = vanillaCafInfo,
 431             arityInfo           = unknownArity,
 432 #ifdef OLD_STRICTNESS
 433             cprInfo             = NoCPRInfo,
 434             demandInfo          = wwLazy,
 435             strictnessInfo      = NoStrictnessInfo,
 436 #endif
 437             specInfo            = emptySpecInfo,
 438             workerInfo          = NoWorker,
 439             unfoldingInfo       = noUnfolding,
 440             lbvarInfo           = NoLBVarInfo,
 441             inlinePragInfo      = AlwaysActive,
 442             occInfo             = NoOccInfo,
 443             newDemandInfo       = Nothing,
 444             newStrictnessInfo   = Nothing
 445            }
 446
 447 -- | More informative 'IdInfo' we can use when we know the 'Id' has no CAF references
 448 noCafIdInfo :: IdInfo
 449 noCafIdInfo  = vanillaIdInfo `setCafInfo`    NoCafRefs
 450         -- Used for built-in type Ids in MkId.
 451 \end{code}
 452
 453
 454 %************************************************************************
 455 %*                                                                      *
 456 \subsection[arity-IdInfo]{Arity info about an @Id@}
 457 %*                                                                      *
 458 %************************************************************************
 459
 460 For locally-defined Ids, the code generator maintains its own notion
 461 of their arities; so it should not be asking...  (but other things
 462 besides the code-generator need arity info!)
 463
 464 \begin{code}
 465 -- | An 'ArityInfo' of @n@ tells us that partial application of this
 466 -- 'Id' to up to @n-1@ value arguments does essentially no work.
 467 --
 468 -- That is not necessarily the same as saying that it has @n@ leading
 469 -- lambdas, because coerces may get in the way.
 470 --
 471 -- The arity might increase later in the compilation process, if
 472 -- an extra lambda floats up to the binding site.
 473 type ArityInfo = Arity
 474
 475 -- | It is always safe to assume that an 'Id' has an arity of 0
 476 unknownArity :: Arity
 477 unknownArity = 0 :: Arity
 478
 479 ppArityInfo :: Int -> SDoc
 480 ppArityInfo 0 = empty
 481 ppArityInfo n = hsep [ptext (sLit "Arity"), int n]
 482 \end{code}
 483
 484 %************************************************************************
 485 %*                                                                      *
 486 \subsection{Inline-pragma information}
 487 %*                                                                      *
 488 %************************************************************************
 489
 490 \begin{code}
 491 -- | Tells when the inlining is active.
 492 -- When it is active the thing may be inlined, depending on how
 493 -- big it is.
 494 --
 495 -- If there was an @INLINE@ pragma, then as a separate matter, the
 496 -- RHS will have been made to look small with a Core inline 'Note'
 497 --
 498 -- The default 'InlinePragInfo' is 'AlwaysActive', so the info serves
 499 -- entirely as a way to inhibit inlining until we want it
 500 type InlinePragInfo = Activation
 501 \end{code}
 502
 503
 504 %************************************************************************
 505 %*                                                                      *
 506         SpecInfo
 507 %*                                                                      *
 508 %************************************************************************
 509
 510 \begin{code}
 511 -- | Records the specializations of this 'Id' that we know about
 512 -- in the form of rewrite 'CoreRule's that target them
 513 data SpecInfo
 514   = SpecInfo
 515         [CoreRule]
 516         VarSet          -- Locally-defined free vars of *both* LHS and RHS
 517                         -- of rules.  I don't think it needs to include the
 518                         -- ru_fn though.
 519                         -- Note [Rule dependency info] in OccurAnal
 520
 521 -- | Assume that no specilizations exist: always safe
 522 emptySpecInfo :: SpecInfo
 523 emptySpecInfo = SpecInfo [] emptyVarSet
 524
 525 isEmptySpecInfo :: SpecInfo -> Bool
 526 isEmptySpecInfo (SpecInfo rs _) = null rs
 527
 528 -- | Retrieve the locally-defined free variables of both the left and
 529 -- right hand sides of the specialization rules
 530 specInfoFreeVars :: SpecInfo -> VarSet
 531 specInfoFreeVars (SpecInfo _ fvs) = fvs
 532
 533 specInfoRules :: SpecInfo -> [CoreRule]
 534 specInfoRules (SpecInfo rules _) = rules
 535
 536 -- | Change the name of the function the rule is keyed on on all of the 'CoreRule's
 537 setSpecInfoHead :: Name -> SpecInfo -> SpecInfo
 538 setSpecInfoHead fn (SpecInfo rules fvs)
 539   = SpecInfo (map (setRuleIdName fn) rules) fvs
 540
 541 seqSpecInfo :: SpecInfo -> ()
 542 seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs
 543 \end{code}
 544
 545 %************************************************************************
 546 %*                                                                      *
 547 \subsection[worker-IdInfo]{Worker info about an @Id@}
 548 %*                                                                      *
 549 %************************************************************************
 550
 551 There might not be a worker, even for a strict function, because:
 552 (a) the function might be small enough to inline, so no need
 553     for w/w split
 554 (b) the strictness info might be "SSS" or something, so no w/w split.
 555
 556 Sometimes the arity of a wrapper changes from the original arity from
 557 which it was generated, so we always emit the "original" arity into
 558 the interface file, as part of the worker info.
 559
 560 How can this happen?  Sometimes we get
 561         f = coerce t (\x y -> $wf x y)
 562 at the moment of w/w split; but the eta reducer turns it into
 563         f = coerce t $wf
 564 which is perfectly fine except that the exposed arity so far as
 565 the code generator is concerned (zero) differs from the arity
 566 when we did the split (2).
 567
 568 All this arises because we use 'arity' to mean "exactly how many
 569 top level lambdas are there" in interface files; but during the
 570 compilation of this module it means "how many things can I apply
 571 this to".
 572
 573 \begin{code}
 574
 575 -- | If this Id has a worker then we store a reference to it. Worker
 576 -- functions are generated by the worker\/wrapper pass, using information
 577 -- information from strictness analysis.
 578 data WorkerInfo = NoWorker              -- ^ No known worker function
 579                 | HasWorker Id Arity    -- ^ The 'Arity' is the arity of the /wrapper/ at the moment of the
 580                                         -- worker\/wrapper split, which may be different from the current 'Id' 'Aritiy'
 581
 582 seqWorker :: WorkerInfo -> ()
 583 seqWorker (HasWorker id a) = id `seq` a `seq` ()
 584 seqWorker NoWorker         = ()
 585
 586 ppWorkerInfo :: WorkerInfo -> SDoc
 587 ppWorkerInfo NoWorker            = empty
 588 ppWorkerInfo (HasWorker wk_id _) = ptext (sLit "Worker") <+> ppr wk_id
 589
 590 workerExists :: WorkerInfo -> Bool
 591 workerExists NoWorker        = False
 592 workerExists (HasWorker _ _) = True
 593
 594 -- | The 'Id' of the worker function if it exists, or a panic otherwise
 595 workerId :: WorkerInfo -> Id
 596 workerId (HasWorker id _) = id
 597 workerId NoWorker = panic "workerId: NoWorker"
 598
 599 -- | The 'Arity' of the worker function at the time of the split if it exists, or a panic otherwise
 600 wrapperArity :: WorkerInfo -> Arity
 601 wrapperArity (HasWorker _ a) = a
 602 wrapperArity NoWorker = panic "wrapperArity: NoWorker"
 603 \end{code}
 604
 605
 606 %************************************************************************
 607 %*                                                                      *
 608 \subsection[CG-IdInfo]{Code generator-related information}
 609 %*                                                                      *
 610 %************************************************************************
 611
 612 \begin{code}
 613 -- CafInfo is used to build Static Reference Tables (see simplStg/SRT.lhs).
 614
 615 -- | Records whether an 'Id' makes Constant Applicative Form references
 616 data CafInfo
 617         = MayHaveCafRefs                -- ^ Indicates that the 'Id' is for either:
 618                                         --
 619                                         -- 1. A function or static constructor
 620                                         --    that refers to one or more CAFs, or
 621                                         --
 622                                         -- 2. A real live CAF
 623
 624         | NoCafRefs                     -- ^ A function or static constructor
 625                                         -- that refers to no CAFs.
 626         deriving (Eq, Ord)
 627
 628 -- | Assumes that the 'Id' has CAF references: definitely safe
 629 vanillaCafInfo :: CafInfo
 630 vanillaCafInfo = MayHaveCafRefs
 631
 632 mayHaveCafRefs :: CafInfo -> Bool
 633 mayHaveCafRefs  MayHaveCafRefs = True
 634 mayHaveCafRefs _               = False
 635
 636 seqCaf :: CafInfo -> ()
 637 seqCaf c = c `seq` ()
 638
 639 ppCafInfo :: CafInfo -> SDoc
 640 ppCafInfo NoCafRefs = ptext (sLit "NoCafRefs")
 641 ppCafInfo MayHaveCafRefs = empty
 642 \end{code}
 643
 644 %************************************************************************
 645 %*                                                                      *
 646 \subsection[cpr-IdInfo]{Constructed Product Result info about an @Id@}
 647 %*                                                                      *
 648 %************************************************************************
 649
 650 \begin{code}
 651 #ifdef OLD_STRICTNESS
 652 -- | If the @Id@ is a function then it may have Constructed Product Result
 653 -- (CPR) info. A CPR analysis phase detects whether:
 654 --
 655 -- 1. The function's return value has a product type, i.e. an algebraic  type
 656 -- with a single constructor. Examples of such types are tuples and boxed
 657 -- primitive values.
 658 --
 659 -- 2. The function always 'constructs' the value that it is returning.  It
 660 -- must do this on every path through,  and it's OK if it calls another
 661 -- function which constructs the result.
 662 --
 663 -- If this is the case then we store a template which tells us the
 664 -- function has the CPR property and which components of the result are
 665 -- also CPRs.
 666 data CprInfo
 667   = NoCPRInfo   -- ^ No, this function does not return a constructed product
 668   | ReturnsCPR  -- ^ Yes, this function returns a constructed product
 669
 670                 -- Implicitly, this means "after the function has been applied
 671                 -- to all its arguments", so the worker\/wrapper builder in
 672                 -- WwLib.mkWWcpr checks that that it is indeed saturated before
 673                 -- making use of the CPR info
 674
 675         -- We used to keep nested info about sub-components, but
 676         -- we never used it so I threw it away
 677
 678 -- | It's always safe to assume that an 'Id' does not have the CPR property
 679 noCprInfo :: CprInt
 680 noCprInfo = NoCPRInfo
 681
 682 seqCpr :: CprInfo -> ()
 683 seqCpr ReturnsCPR = ()
 684 seqCpr NoCPRInfo  = ()
 685
 686 ppCprInfo NoCPRInfo  = empty
 687 ppCprInfo ReturnsCPR = ptext (sLit "__M")
 688
 689 instance Outputable CprInfo where
 690     ppr = ppCprInfo
 691
 692 instance Show CprInfo where
 693     showsPrec p c = showsPrecSDoc p (ppr c)
 694 #endif
 695 \end{code}
 696
 697 %************************************************************************
 698 %*                                                                      *
 699 \subsection[lbvar-IdInfo]{Lambda-bound var info about an @Id@}
 700 %*                                                                      *
 701 %************************************************************************
 702
 703 \begin{code}
 704 -- | If the 'Id' is a lambda-bound variable then it may have lambda-bound
 705 -- variable info. Sometimes we know whether the lambda binding this variable
 706 -- is a \"one-shot\" lambda; that is, whether it is applied at most once.
 707 --
 708 -- This information may be useful in optimisation, as computations may
 709 -- safely be floated inside such a lambda without risk of duplicating
 710 -- work.
 711 data LBVarInfo = NoLBVarInfo            -- ^ No information
 712                | IsOneShotLambda        -- ^ The lambda is applied at most once).
 713
 714 -- | It is always safe to assume that an 'Id' has no lambda-bound variable information
 715 noLBVarInfo :: LBVarInfo
 716 noLBVarInfo = NoLBVarInfo
 717
 718 hasNoLBVarInfo :: LBVarInfo -> Bool
 719 hasNoLBVarInfo NoLBVarInfo     = True
 720 hasNoLBVarInfo IsOneShotLambda = False
 721
 722 seqLBVar :: LBVarInfo -> ()
 723 seqLBVar l = l `seq` ()
 724
 725 pprLBVarInfo :: LBVarInfo -> SDoc
 726 pprLBVarInfo NoLBVarInfo     = empty
 727 pprLBVarInfo IsOneShotLambda = ptext (sLit "OneShot")
 728
 729 instance Outputable LBVarInfo where
 730     ppr = pprLBVarInfo
 731
 732 instance Show LBVarInfo where
 733     showsPrec p c = showsPrecSDoc p (ppr c)
 734 \end{code}
 735
 736
 737 %************************************************************************
 738 %*                                                                      *
 739 \subsection{Bulk operations on IdInfo}
 740 %*                                                                      *
 741 %************************************************************************
 742
 743 \begin{code}
 744 -- | This is used to remove information on lambda binders that we have
 745 -- setup as part of a lambda group, assuming they will be applied all at once,
 746 -- but turn out to be part of an unsaturated lambda as in e.g:
 747 --
 748 -- > (\x1. \x2. e) arg1
 749 zapLamInfo :: IdInfo -> Maybe IdInfo
 750 zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand})
 751   | is_safe_occ occ && is_safe_dmd demand
 752   = Nothing
 753   | otherwise
 754   = Just (info {occInfo = safe_occ, newDemandInfo = Nothing})
 755   where
 756         -- The "unsafe" occ info is the ones that say I'm not in a lambda
 757         -- because that might not be true for an unsaturated lambda
 758     is_safe_occ (OneOcc in_lam _ _) = in_lam
 759     is_safe_occ _other              = True
 760
 761     safe_occ = case occ of
 762                  OneOcc _ once int_cxt -> OneOcc insideLam once int_cxt
 763                  _other                -> occ
 764
 765     is_safe_dmd Nothing    = True
 766     is_safe_dmd (Just dmd) = not (isStrictDmd dmd)
 767 \end{code}
 768
 769 \begin{code}
 770 -- | Remove demand info on the 'IdInfo' if it is present, otherwise return @Nothing@
 771 zapDemandInfo :: IdInfo -> Maybe IdInfo
 772 zapDemandInfo info@(IdInfo {newDemandInfo = dmd})
 773   | isJust dmd = Just (info {newDemandInfo = Nothing})
 774   | otherwise  = Nothing
 775 \end{code}
 776
 777 \begin{code}
 778 zapFragileInfo :: IdInfo -> Maybe IdInfo
 779 -- ^ Zap info that depends on free variables
 780 zapFragileInfo info
 781   = Just (info `setSpecInfo` emptySpecInfo
 782                `setWorkerInfo` NoWorker
 783                `setUnfoldingInfo` noUnfolding
 784                `setOccInfo` if isFragileOcc occ then NoOccInfo else occ)
 785   where
 786     occ = occInfo info
 787 \end{code}
 788
 789 %************************************************************************
 790 %*                                                                      *
 791 \subsection{TickBoxOp}
 792 %*                                                                      *
 793 %************************************************************************
 794
 795 \begin{code}
 796 type TickBoxId = Int
 797
 798 -- | Tick box for Hpc-style coverage
 799 data TickBoxOp
 800    = TickBox Module {-# UNPACK #-} !TickBoxId
 801
 802 instance Outputable TickBoxOp where
 803     ppr (TickBox mod n)         = ptext (sLit "tick") <+> ppr (mod,n)
 804 \end{code}