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