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 IdDetails type
  13         IdDetails(..), pprIdDetails,
  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                      IdDetails
 238 %*                                                                      *
 239 %************************************************************************
 240
 241 \begin{code}
 242 -- | The 'IdDetails' of an 'Id' give stable, and necessary,
 243 -- information about the Id.
 244 data IdDetails
 245   = VanillaId
 246
 247   -- | The 'Id' for a record selector
 248   | RecSelId
 249     { sel_tycon   :: TyCon      -- ^ For a data type family, this is the /instance/ 'TyCon'
 250                                 --   not the family 'TyCon'
 251     , sel_naughty :: Bool       -- True <=> a "naughty" selector which can't actually exist, for example @x@ in:
 252                                 --    data T = forall a. MkT { x :: a }
 253     }                           -- See Note [Naughty record selectors] in TcTyClsDecls
 254
 255   | DataConWorkId DataCon       -- ^ The 'Id' is for a data constructor /worker/
 256   | DataConWrapId DataCon       -- ^ The 'Id' is for a data constructor /wrapper/
 257
 258                                 -- [the only reasons we need to know is so that
 259                                 --  a) to support isImplicitId
 260                                 --  b) when desugaring a RecordCon we can get
 261                                 --     from the Id back to the data con]
 262
 263   | ClassOpId Class             -- ^ The 'Id' is an operation of a class
 264
 265   | PrimOpId PrimOp             -- ^ The 'Id' is for a primitive operator
 266   | FCallId ForeignCall         -- ^ The 'Id' is for a foreign call
 267
 268   | TickBoxOpId TickBoxOp       -- ^ The 'Id' is for a HPC tick box (both traditional and binary)
 269
 270   | DFunId                      -- ^ A dictionary function.  We don't use this in an essential way,
 271                                 -- currently, but it's kind of nice that we can keep track of
 272                                 -- which Ids are DFuns, across module boundaries too
 273
 274
 275 instance Outputable IdDetails where
 276     ppr = pprIdDetails
 277
 278 pprIdDetails :: IdDetails -> SDoc
 279 pprIdDetails VanillaId         = empty
 280 pprIdDetails (DataConWorkId _) = ptext (sLit "[DataCon]")
 281 pprIdDetails (DataConWrapId _) = ptext (sLit "[DataConWrapper]")
 282 pprIdDetails (ClassOpId _)     = ptext (sLit "[ClassOp]")
 283 pprIdDetails (PrimOpId _)      = ptext (sLit "[PrimOp]")
 284 pprIdDetails (FCallId _)       = ptext (sLit "[ForeignCall]")
 285 pprIdDetails (TickBoxOpId _)   = ptext (sLit "[TickBoxOp]")
 286 pprIdDetails DFunId            = ptext (sLit "[DFunId]")
 287 pprIdDetails (RecSelId { sel_naughty = is_naughty })
 288   = brackets $ ptext (sLit "RecSel") <> pp_naughty
 289   where
 290     pp_naughty | is_naughty = ptext (sLit "(naughty)")
 291                | otherwise  = empty
 292 \end{code}
 293
 294
 295 %************************************************************************
 296 %*                                                                      *
 297 \subsection{The main IdInfo type}
 298 %*                                                                      *
 299 %************************************************************************
 300
 301 \begin{code}
 302 -- | An 'IdInfo' gives /optional/ information about an 'Id'.  If
 303 -- present it never lies, but it may not be present, in which case there
 304 -- is always a conservative assumption which can be made.
 305 --
 306 -- Two 'Id's may have different info even though they have the same
 307 -- 'Unique' (and are hence the same 'Id'); for example, one might lack
 308 -- the properties attached to the other.
 309 --
 310 -- The 'IdInfo' gives information about the value, or definition, of the
 311 -- 'Id'.  It does not contain information about the 'Id''s usage,
 312 -- except for 'demandInfo' and 'lbvarInfo'.
 313 data IdInfo
 314   = IdInfo {
 315         arityInfo       :: !ArityInfo,          -- ^ 'Id' arity
 316         specInfo        :: SpecInfo,            -- ^ Specialisations of the 'Id's function which exist
 317 #ifdef OLD_STRICTNESS
 318         cprInfo         :: CprInfo,             -- ^ If the 'Id's function always constructs a product result
 319         demandInfo      :: Demand.Demand,       -- ^ Whether or not the 'Id' is definitely demanded
 320         strictnessInfo  :: StrictnessInfo,      -- ^ 'Id' strictness properties
 321 #endif
 322         workerInfo      :: WorkerInfo,          -- ^ Pointer to worker function.
 323                                                 -- Within one module this is irrelevant; the
 324                                                 -- inlining of a worker is handled via the 'Unfolding'.
 325                                                 -- However, when the module is imported by others, the
 326                                                 -- 'WorkerInfo' is used /only/ to indicate the form of
 327                                                 -- the RHS, so that interface files don't actually
 328                                                 -- need to contain the RHS; it can be derived from
 329                                                 -- the strictness info
 330
 331         unfoldingInfo   :: Unfolding,           -- ^ The 'Id's unfolding
 332         cafInfo         :: CafInfo,             -- ^ 'Id' CAF info
 333         lbvarInfo       :: LBVarInfo,           -- ^ Info about a lambda-bound variable, if the 'Id' is one
 334         inlinePragInfo  :: InlinePragma,        -- ^ Any inline pragma atached to the 'Id'
 335         occInfo         :: OccInfo,             -- ^ How the 'Id' occurs in the program
 336
 337         newStrictnessInfo :: Maybe StrictSig,   -- ^ Id strictness information. Reason for Maybe:
 338                                                 -- the DmdAnal phase needs to know whether
 339                                                 -- this is the first visit, so it can assign botSig.
 340                                                 -- Other customers want topSig.  So @Nothing@ is good.
 341
 342         newDemandInfo     :: Maybe Demand       -- ^ Id demand information. Similarly we want to know
 343                                                 -- if there's no known demand yet, for when we are looking
 344                                                 -- for CPR info
 345     }
 346
 347 -- | Just evaluate the 'IdInfo' to WHNF
 348 seqIdInfo :: IdInfo -> ()
 349 seqIdInfo (IdInfo {}) = ()
 350
 351 -- | Evaluate all the fields of the 'IdInfo' that are generally demanded by the
 352 -- compiler
 353 megaSeqIdInfo :: IdInfo -> ()
 354 megaSeqIdInfo info
 355   = seqSpecInfo (specInfo info)                 `seq`
 356     seqWorker (workerInfo info)                 `seq`
 357
 358 -- Omitting this improves runtimes a little, presumably because
 359 -- some unfoldings are not calculated at all
 360 --    seqUnfolding (unfoldingInfo info)         `seq`
 361
 362     seqNewDemandInfo (newDemandInfo info)       `seq`
 363     seqNewStrictnessInfo (newStrictnessInfo info) `seq`
 364
 365 #ifdef OLD_STRICTNESS
 366     Demand.seqDemand (demandInfo info)          `seq`
 367     seqStrictnessInfo (strictnessInfo info)     `seq`
 368     seqCpr (cprInfo info)                       `seq`
 369 #endif
 370
 371     seqCaf (cafInfo info)                       `seq`
 372     seqLBVar (lbvarInfo info)                   `seq`
 373     seqOccInfo (occInfo info)
 374 \end{code}
 375
 376 Setters
 377
 378 \begin{code}
 379 setWorkerInfo :: IdInfo -> WorkerInfo -> IdInfo
 380 setWorkerInfo     info wk = wk `seq` info { workerInfo = wk }
 381 setSpecInfo :: IdInfo -> SpecInfo -> IdInfo
 382 setSpecInfo       info sp = sp `seq` info { specInfo = sp }
 383 setInlinePragInfo :: IdInfo -> InlinePragma -> IdInfo
 384 setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr }
 385 setOccInfo :: IdInfo -> OccInfo -> IdInfo
 386 setOccInfo        info oc = oc `seq` info { occInfo = oc }
 387 #ifdef OLD_STRICTNESS
 388 setStrictnessInfo info st = st `seq` info { strictnessInfo = st }
 389 #endif
 390         -- Try to avoid spack leaks by seq'ing
 391
 392 setUnfoldingInfoLazily :: IdInfo -> Unfolding -> IdInfo
 393 setUnfoldingInfoLazily info uf  -- Lazy variant to avoid looking at the
 394   =                             -- unfolding of an imported Id unless necessary
 395     info { unfoldingInfo = uf } -- (In this case the demand-zapping is redundant.)
 396
 397 setUnfoldingInfo :: IdInfo -> Unfolding -> IdInfo
 398 setUnfoldingInfo info uf
 399         -- We do *not* seq on the unfolding info, For some reason, doing so
 400         -- actually increases residency significantly.
 401   = info { unfoldingInfo = uf }
 402
 403 #ifdef OLD_STRICTNESS
 404 setDemandInfo     info dd = info { demandInfo = dd }
 405 setCprInfo        info cp = info { cprInfo = cp }
 406 #endif
 407
 408 setArityInfo :: IdInfo -> ArityInfo -> IdInfo
 409 setArityInfo      info ar  = info { arityInfo = ar  }
 410 setCafInfo :: IdInfo -> CafInfo -> IdInfo
 411 setCafInfo        info caf = info { cafInfo = caf }
 412
 413 setLBVarInfo :: IdInfo -> LBVarInfo -> IdInfo
 414 setLBVarInfo      info lb = {-lb `seq`-} info { lbvarInfo = lb }
 415
 416 setNewDemandInfo :: IdInfo -> Maybe Demand -> IdInfo
 417 setNewDemandInfo     info dd = dd `seq` info { newDemandInfo = dd }
 418 setNewStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo
 419 setNewStrictnessInfo info dd = dd `seq` info { newStrictnessInfo = dd }
 420 \end{code}
 421
 422
 423 \begin{code}
 424 -- | Basic 'IdInfo' that carries no useful information whatsoever
 425 vanillaIdInfo :: IdInfo
 426 vanillaIdInfo
 427   = IdInfo {
 428             cafInfo             = vanillaCafInfo,
 429             arityInfo           = unknownArity,
 430 #ifdef OLD_STRICTNESS
 431             cprInfo             = NoCPRInfo,
 432             demandInfo          = wwLazy,
 433             strictnessInfo      = NoStrictnessInfo,
 434 #endif
 435             specInfo            = emptySpecInfo,
 436             workerInfo          = NoWorker,
 437             unfoldingInfo       = noUnfolding,
 438             lbvarInfo           = NoLBVarInfo,
 439             inlinePragInfo      = defaultInlinePragma,
 440             occInfo             = NoOccInfo,
 441             newDemandInfo       = Nothing,
 442             newStrictnessInfo   = Nothing
 443            }
 444
 445 -- | More informative 'IdInfo' we can use when we know the 'Id' has no CAF references
 446 noCafIdInfo :: IdInfo
 447 noCafIdInfo  = vanillaIdInfo `setCafInfo`    NoCafRefs
 448         -- Used for built-in type Ids in MkId.
 449 \end{code}
 450
 451
 452 %************************************************************************
 453 %*                                                                      *
 454 \subsection[arity-IdInfo]{Arity info about an @Id@}
 455 %*                                                                      *
 456 %************************************************************************
 457
 458 For locally-defined Ids, the code generator maintains its own notion
 459 of their arities; so it should not be asking...  (but other things
 460 besides the code-generator need arity info!)
 461
 462 \begin{code}
 463 -- | An 'ArityInfo' of @n@ tells us that partial application of this
 464 -- 'Id' to up to @n-1@ value arguments does essentially no work.
 465 --
 466 -- That is not necessarily the same as saying that it has @n@ leading
 467 -- lambdas, because coerces may get in the way.
 468 --
 469 -- The arity might increase later in the compilation process, if
 470 -- an extra lambda floats up to the binding site.
 471 type ArityInfo = Arity
 472
 473 -- | It is always safe to assume that an 'Id' has an arity of 0
 474 unknownArity :: Arity
 475 unknownArity = 0 :: Arity
 476
 477 ppArityInfo :: Int -> SDoc
 478 ppArityInfo 0 = empty
 479 ppArityInfo n = hsep [ptext (sLit "Arity"), int n]
 480 \end{code}
 481
 482 %************************************************************************
 483 %*                                                                      *
 484 \subsection{Inline-pragma information}
 485 %*                                                                      *
 486 %************************************************************************
 487
 488 \begin{code}
 489 -- | Tells when the inlining is active.
 490 -- When it is active the thing may be inlined, depending on how
 491 -- big it is.
 492 --
 493 -- If there was an @INLINE@ pragma, then as a separate matter, the
 494 -- RHS will have been made to look small with a Core inline 'Note'
 495 --
 496 -- The default 'InlinePragInfo' is 'AlwaysActive', so the info serves
 497 -- entirely as a way to inhibit inlining until we want it
 498 type InlinePragInfo = InlinePragma
 499 \end{code}
 500
 501
 502 %************************************************************************
 503 %*                                                                      *
 504         SpecInfo
 505 %*                                                                      *
 506 %************************************************************************
 507
 508 \begin{code}
 509 -- | Records the specializations of this 'Id' that we know about
 510 -- in the form of rewrite 'CoreRule's that target them
 511 data SpecInfo
 512   = SpecInfo
 513         [CoreRule]
 514         VarSet          -- Locally-defined free vars of *both* LHS and RHS
 515                         -- of rules.  I don't think it needs to include the
 516                         -- ru_fn though.
 517                         -- Note [Rule dependency info] in OccurAnal
 518
 519 -- | Assume that no specilizations exist: always safe
 520 emptySpecInfo :: SpecInfo
 521 emptySpecInfo = SpecInfo [] emptyVarSet
 522
 523 isEmptySpecInfo :: SpecInfo -> Bool
 524 isEmptySpecInfo (SpecInfo rs _) = null rs
 525
 526 -- | Retrieve the locally-defined free variables of both the left and
 527 -- right hand sides of the specialization rules
 528 specInfoFreeVars :: SpecInfo -> VarSet
 529 specInfoFreeVars (SpecInfo _ fvs) = fvs
 530
 531 specInfoRules :: SpecInfo -> [CoreRule]
 532 specInfoRules (SpecInfo rules _) = rules
 533
 534 -- | Change the name of the function the rule is keyed on on all of the 'CoreRule's
 535 setSpecInfoHead :: Name -> SpecInfo -> SpecInfo
 536 setSpecInfoHead fn (SpecInfo rules fvs)
 537   = SpecInfo (map (setRuleIdName fn) rules) fvs
 538
 539 seqSpecInfo :: SpecInfo -> ()
 540 seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs
 541 \end{code}
 542
 543 %************************************************************************
 544 %*                                                                      *
 545 \subsection[worker-IdInfo]{Worker info about an @Id@}
 546 %*                                                                      *
 547 %************************************************************************
 548
 549 There might not be a worker, even for a strict function, because:
 550 (a) the function might be small enough to inline, so no need
 551     for w/w split
 552 (b) the strictness info might be "SSS" or something, so no w/w split.
 553
 554 Sometimes the arity of a wrapper changes from the original arity from
 555 which it was generated, so we always emit the "original" arity into
 556 the interface file, as part of the worker info.
 557
 558 How can this happen?  Sometimes we get
 559         f = coerce t (\x y -> $wf x y)
 560 at the moment of w/w split; but the eta reducer turns it into
 561         f = coerce t $wf
 562 which is perfectly fine except that the exposed arity so far as
 563 the code generator is concerned (zero) differs from the arity
 564 when we did the split (2).
 565
 566 All this arises because we use 'arity' to mean "exactly how many
 567 top level lambdas are there" in interface files; but during the
 568 compilation of this module it means "how many things can I apply
 569 this to".
 570
 571 \begin{code}
 572
 573 -- | If this Id has a worker then we store a reference to it. Worker
 574 -- functions are generated by the worker\/wrapper pass, using information
 575 -- information from strictness analysis.
 576 data WorkerInfo = NoWorker              -- ^ No known worker function
 577                 | HasWorker Id Arity    -- ^ The 'Arity' is the arity of the /wrapper/ at the moment of the
 578                                         -- worker\/wrapper split, which may be different from the current 'Id' 'Aritiy'
 579
 580 seqWorker :: WorkerInfo -> ()
 581 seqWorker (HasWorker id a) = id `seq` a `seq` ()
 582 seqWorker NoWorker         = ()
 583
 584 ppWorkerInfo :: WorkerInfo -> SDoc
 585 ppWorkerInfo NoWorker            = empty
 586 ppWorkerInfo (HasWorker wk_id _) = ptext (sLit "Worker") <+> ppr wk_id
 587
 588 workerExists :: WorkerInfo -> Bool
 589 workerExists NoWorker        = False
 590 workerExists (HasWorker _ _) = True
 591
 592 -- | The 'Id' of the worker function if it exists, or a panic otherwise
 593 workerId :: WorkerInfo -> Id
 594 workerId (HasWorker id _) = id
 595 workerId NoWorker = panic "workerId: NoWorker"
 596
 597 -- | The 'Arity' of the worker function at the time of the split if it exists, or a panic otherwise
 598 wrapperArity :: WorkerInfo -> Arity
 599 wrapperArity (HasWorker _ a) = a
 600 wrapperArity NoWorker = panic "wrapperArity: NoWorker"
 601 \end{code}
 602
 603
 604 %************************************************************************
 605 %*                                                                      *
 606 \subsection[CG-IdInfo]{Code generator-related information}
 607 %*                                                                      *
 608 %************************************************************************
 609
 610 \begin{code}
 611 -- CafInfo is used to build Static Reference Tables (see simplStg/SRT.lhs).
 612
 613 -- | Records whether an 'Id' makes Constant Applicative Form references
 614 data CafInfo
 615         = MayHaveCafRefs                -- ^ Indicates that the 'Id' is for either:
 616                                         --
 617                                         -- 1. A function or static constructor
 618                                         --    that refers to one or more CAFs, or
 619                                         --
 620                                         -- 2. A real live CAF
 621
 622         | NoCafRefs                     -- ^ A function or static constructor
 623                                         -- that refers to no CAFs.
 624         deriving (Eq, Ord)
 625
 626 -- | Assumes that the 'Id' has CAF references: definitely safe
 627 vanillaCafInfo :: CafInfo
 628 vanillaCafInfo = MayHaveCafRefs
 629
 630 mayHaveCafRefs :: CafInfo -> Bool
 631 mayHaveCafRefs  MayHaveCafRefs = True
 632 mayHaveCafRefs _               = False
 633
 634 seqCaf :: CafInfo -> ()
 635 seqCaf c = c `seq` ()
 636
 637 ppCafInfo :: CafInfo -> SDoc
 638 ppCafInfo NoCafRefs = ptext (sLit "NoCafRefs")
 639 ppCafInfo MayHaveCafRefs = empty
 640 \end{code}
 641
 642 %************************************************************************
 643 %*                                                                      *
 644 \subsection[cpr-IdInfo]{Constructed Product Result info about an @Id@}
 645 %*                                                                      *
 646 %************************************************************************
 647
 648 \begin{code}
 649 #ifdef OLD_STRICTNESS
 650 -- | If the @Id@ is a function then it may have Constructed Product Result
 651 -- (CPR) info. A CPR analysis phase detects whether:
 652 --
 653 -- 1. The function's return value has a product type, i.e. an algebraic  type
 654 -- with a single constructor. Examples of such types are tuples and boxed
 655 -- primitive values.
 656 --
 657 -- 2. The function always 'constructs' the value that it is returning.  It
 658 -- must do this on every path through,  and it's OK if it calls another
 659 -- function which constructs the result.
 660 --
 661 -- If this is the case then we store a template which tells us the
 662 -- function has the CPR property and which components of the result are
 663 -- also CPRs.
 664 data CprInfo
 665   = NoCPRInfo   -- ^ No, this function does not return a constructed product
 666   | ReturnsCPR  -- ^ Yes, this function returns a constructed product
 667
 668                 -- Implicitly, this means "after the function has been applied
 669                 -- to all its arguments", so the worker\/wrapper builder in
 670                 -- WwLib.mkWWcpr checks that that it is indeed saturated before
 671                 -- making use of the CPR info
 672
 673         -- We used to keep nested info about sub-components, but
 674         -- we never used it so I threw it away
 675
 676 -- | It's always safe to assume that an 'Id' does not have the CPR property
 677 noCprInfo :: CprInt
 678 noCprInfo = NoCPRInfo
 679
 680 seqCpr :: CprInfo -> ()
 681 seqCpr ReturnsCPR = ()
 682 seqCpr NoCPRInfo  = ()
 683
 684 ppCprInfo NoCPRInfo  = empty
 685 ppCprInfo ReturnsCPR = ptext (sLit "__M")
 686
 687 instance Outputable CprInfo where
 688     ppr = ppCprInfo
 689
 690 instance Show CprInfo where
 691     showsPrec p c = showsPrecSDoc p (ppr c)
 692 #endif
 693 \end{code}
 694
 695 %************************************************************************
 696 %*                                                                      *
 697 \subsection[lbvar-IdInfo]{Lambda-bound var info about an @Id@}
 698 %*                                                                      *
 699 %************************************************************************
 700
 701 \begin{code}
 702 -- | If the 'Id' is a lambda-bound variable then it may have lambda-bound
 703 -- variable info. Sometimes we know whether the lambda binding this variable
 704 -- is a \"one-shot\" lambda; that is, whether it is applied at most once.
 705 --
 706 -- This information may be useful in optimisation, as computations may
 707 -- safely be floated inside such a lambda without risk of duplicating
 708 -- work.
 709 data LBVarInfo = NoLBVarInfo            -- ^ No information
 710                | IsOneShotLambda        -- ^ The lambda is applied at most once).
 711
 712 -- | It is always safe to assume that an 'Id' has no lambda-bound variable information
 713 noLBVarInfo :: LBVarInfo
 714 noLBVarInfo = NoLBVarInfo
 715
 716 hasNoLBVarInfo :: LBVarInfo -> Bool
 717 hasNoLBVarInfo NoLBVarInfo     = True
 718 hasNoLBVarInfo IsOneShotLambda = False
 719
 720 seqLBVar :: LBVarInfo -> ()
 721 seqLBVar l = l `seq` ()
 722
 723 pprLBVarInfo :: LBVarInfo -> SDoc
 724 pprLBVarInfo NoLBVarInfo     = empty
 725 pprLBVarInfo IsOneShotLambda = ptext (sLit "OneShot")
 726
 727 instance Outputable LBVarInfo where
 728     ppr = pprLBVarInfo
 729
 730 instance Show LBVarInfo where
 731     showsPrec p c = showsPrecSDoc p (ppr c)
 732 \end{code}
 733
 734
 735 %************************************************************************
 736 %*                                                                      *
 737 \subsection{Bulk operations on IdInfo}
 738 %*                                                                      *
 739 %************************************************************************
 740
 741 \begin{code}
 742 -- | This is used to remove information on lambda binders that we have
 743 -- setup as part of a lambda group, assuming they will be applied all at once,
 744 -- but turn out to be part of an unsaturated lambda as in e.g:
 745 --
 746 -- > (\x1. \x2. e) arg1
 747 zapLamInfo :: IdInfo -> Maybe IdInfo
 748 zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand})
 749   | is_safe_occ occ && is_safe_dmd demand
 750   = Nothing
 751   | otherwise
 752   = Just (info {occInfo = safe_occ, newDemandInfo = Nothing})
 753   where
 754         -- The "unsafe" occ info is the ones that say I'm not in a lambda
 755         -- because that might not be true for an unsaturated lambda
 756     is_safe_occ (OneOcc in_lam _ _) = in_lam
 757     is_safe_occ _other              = True
 758
 759     safe_occ = case occ of
 760                  OneOcc _ once int_cxt -> OneOcc insideLam once int_cxt
 761                  _other                -> occ
 762
 763     is_safe_dmd Nothing    = True
 764     is_safe_dmd (Just dmd) = not (isStrictDmd dmd)
 765 \end{code}
 766
 767 \begin{code}
 768 -- | Remove demand info on the 'IdInfo' if it is present, otherwise return @Nothing@
 769 zapDemandInfo :: IdInfo -> Maybe IdInfo
 770 zapDemandInfo info@(IdInfo {newDemandInfo = dmd})
 771   | isJust dmd = Just (info {newDemandInfo = Nothing})
 772   | otherwise  = Nothing
 773 \end{code}
 774
 775 \begin{code}
 776 zapFragileInfo :: IdInfo -> Maybe IdInfo
 777 -- ^ Zap info that depends on free variables
 778 zapFragileInfo info
 779   = Just (info `setSpecInfo` emptySpecInfo
 780                `setWorkerInfo` NoWorker
 781                `setUnfoldingInfo` noUnfolding
 782                `setOccInfo` if isFragileOcc occ then NoOccInfo else occ)
 783   where
 784     occ = occInfo info
 785 \end{code}
 786
 787 %************************************************************************
 788 %*                                                                      *
 789 \subsection{TickBoxOp}
 790 %*                                                                      *
 791 %************************************************************************
 792
 793 \begin{code}
 794 type TickBoxId = Int
 795
 796 -- | Tick box for Hpc-style coverage
 797 data TickBoxOp
 798    = TickBox Module {-# UNPACK #-} !TickBoxId
 799
 800 instance Outputable TickBoxOp where
 801     ppr (TickBox mod n)         = ptext (sLit "tick") <+> ppr (mod,n)
 802 \end{code}