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