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 8Haskell. [WDP 94/11]) 9-} 10 11{-# LANGUAGE CPP #-} 12{-# LANGUAGE FlexibleContexts #-} 13{-# LANGUAGE BinaryLiterals #-} 14 15{-# OPTIONS_GHC -Wno-incomplete-record-updates #-} 16 17module GHC.Types.Id.Info ( 18 -- * The IdDetails type 19 IdDetails(..), pprIdDetails, coVarDetails, isCoVarDetails, 20 JoinArity, isJoinIdDetails_maybe, 21 RecSelParent(..), 22 23 -- * The IdInfo type 24 IdInfo, -- Abstract 25 vanillaIdInfo, noCafIdInfo, 26 27 -- ** The OneShotInfo type 28 OneShotInfo(..), 29 oneShotInfo, noOneShotInfo, hasNoOneShotInfo, 30 setOneShotInfo, 31 32 -- ** Zapping various forms of Info 33 zapLamInfo, zapFragileInfo, 34 zapDemandInfo, zapUsageInfo, zapUsageEnvInfo, zapUsedOnceInfo, 35 zapTailCallInfo, zapCallArityInfo, zapUnfolding, 36 37 -- ** The ArityInfo type 38 ArityInfo, 39 unknownArity, 40 arityInfo, setArityInfo, ppArityInfo, 41 42 callArityInfo, setCallArityInfo, 43 44 -- ** Demand and strictness Info 45 strictnessInfo, setStrictnessInfo, 46 cprInfo, setCprInfo, 47 demandInfo, setDemandInfo, pprStrictness, 48 49 -- ** Unfolding Info 50 unfoldingInfo, setUnfoldingInfo, 51 52 -- ** The InlinePragInfo type 53 InlinePragInfo, 54 inlinePragInfo, setInlinePragInfo, 55 56 -- ** The OccInfo type 57 OccInfo(..), 58 isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker, 59 occInfo, setOccInfo, 60 61 InsideLam(..), BranchCount, 62 63 TailCallInfo(..), 64 tailCallInfo, isAlwaysTailCalled, 65 66 -- ** The RuleInfo type 67 RuleInfo(..), 68 emptyRuleInfo, 69 isEmptyRuleInfo, ruleInfoFreeVars, 70 ruleInfoRules, setRuleInfoHead, 71 ruleInfo, setRuleInfo, 72 73 -- ** The CAFInfo type 74 CafInfo(..), 75 ppCafInfo, mayHaveCafRefs, 76 cafInfo, setCafInfo, 77 78 -- ** The LambdaFormInfo type 79 LambdaFormInfo(..), 80 lfInfo, setLFInfo, 81 82 -- ** Tick-box Info 83 TickBoxOp(..), TickBoxId, 84 85 -- ** Levity info 86 LevityInfo, levityInfo, setNeverLevPoly, setLevityInfoWithType, 87 isNeverLevPolyIdInfo 88 ) where 89 90#include "GhclibHsVersions.h" 91 92import GHC.Prelude 93 94import GHC.Core hiding( hasCoreUnfolding ) 95import GHC.Core( hasCoreUnfolding ) 96 97import GHC.Core.Class 98import {-# SOURCE #-} GHC.Builtin.PrimOps (PrimOp) 99import GHC.Types.Name 100import GHC.Types.Var.Set 101import GHC.Types.Basic 102import GHC.Core.DataCon 103import GHC.Core.TyCon 104import GHC.Core.PatSyn 105import GHC.Core.Type 106import GHC.Types.ForeignCall 107import GHC.Unit.Module 108import GHC.Types.Demand 109import GHC.Types.Cpr 110 111import GHC.Utils.Misc 112import GHC.Utils.Outputable 113import GHC.Utils.Panic 114 115import Data.Word 116 117import GHC.StgToCmm.Types (LambdaFormInfo (..)) 118 119-- infixl so you can say (id `set` a `set` b) 120infixl 1 `setRuleInfo`, 121 `setArityInfo`, 122 `setInlinePragInfo`, 123 `setUnfoldingInfo`, 124 `setOneShotInfo`, 125 `setOccInfo`, 126 `setCafInfo`, 127 `setStrictnessInfo`, 128 `setCprInfo`, 129 `setDemandInfo`, 130 `setNeverLevPoly`, 131 `setLevityInfoWithType` 132 133{- 134************************************************************************ 135* * 136 IdDetails 137* * 138************************************************************************ 139-} 140 141-- | Identifier Details 142-- 143-- The 'IdDetails' of an 'Id' give stable, and necessary, 144-- information about the Id. 145data IdDetails 146 = VanillaId 147 148 -- | The 'Id' for a record selector 149 | RecSelId 150 { sel_tycon :: RecSelParent 151 , sel_naughty :: Bool -- True <=> a "naughty" selector which can't actually exist, for example @x@ in: 152 -- data T = forall a. MkT { x :: a } 153 } -- See Note [Naughty record selectors] in GHC.Tc.TyCl 154 155 | DataConWorkId DataCon -- ^ The 'Id' is for a data constructor /worker/ 156 | DataConWrapId DataCon -- ^ The 'Id' is for a data constructor /wrapper/ 157 158 -- [the only reasons we need to know is so that 159 -- a) to support isImplicitId 160 -- b) when desugaring a RecordCon we can get 161 -- from the Id back to the data con] 162 | ClassOpId Class -- ^ The 'Id' is a superclass selector, 163 -- or class operation of a class 164 165 | PrimOpId PrimOp -- ^ The 'Id' is for a primitive operator 166 | FCallId ForeignCall -- ^ The 'Id' is for a foreign call. 167 -- Type will be simple: no type families, newtypes, etc 168 169 | TickBoxOpId TickBoxOp -- ^ The 'Id' is for a HPC tick box (both traditional and binary) 170 171 | DFunId Bool -- ^ A dictionary function. 172 -- Bool = True <=> the class has only one method, so may be 173 -- implemented with a newtype, so it might be bad 174 -- to be strict on this dictionary 175 176 | CoVarId -- ^ A coercion variable 177 -- This only covers /un-lifted/ coercions, of type 178 -- (t1 ~# t2) or (t1 ~R# t2), not their lifted variants 179 | JoinId JoinArity -- ^ An 'Id' for a join point taking n arguments 180 -- Note [Join points] in "GHC.Core" 181 182-- | Recursive Selector Parent 183data RecSelParent = RecSelData TyCon | RecSelPatSyn PatSyn deriving Eq 184 -- Either `TyCon` or `PatSyn` depending 185 -- on the origin of the record selector. 186 -- For a data type family, this is the 187 -- /instance/ 'TyCon' not the family 'TyCon' 188 189instance Outputable RecSelParent where 190 ppr p = case p of 191 RecSelData ty_con -> ppr ty_con 192 RecSelPatSyn ps -> ppr ps 193 194-- | Just a synonym for 'CoVarId'. Written separately so it can be 195-- exported in the hs-boot file. 196coVarDetails :: IdDetails 197coVarDetails = CoVarId 198 199-- | Check if an 'IdDetails' says 'CoVarId'. 200isCoVarDetails :: IdDetails -> Bool 201isCoVarDetails CoVarId = True 202isCoVarDetails _ = False 203 204isJoinIdDetails_maybe :: IdDetails -> Maybe JoinArity 205isJoinIdDetails_maybe (JoinId join_arity) = Just join_arity 206isJoinIdDetails_maybe _ = Nothing 207 208instance Outputable IdDetails where 209 ppr = pprIdDetails 210 211pprIdDetails :: IdDetails -> SDoc 212pprIdDetails VanillaId = empty 213pprIdDetails other = brackets (pp other) 214 where 215 pp VanillaId = panic "pprIdDetails" 216 pp (DataConWorkId _) = text "DataCon" 217 pp (DataConWrapId _) = text "DataConWrapper" 218 pp (ClassOpId {}) = text "ClassOp" 219 pp (PrimOpId _) = text "PrimOp" 220 pp (FCallId _) = text "ForeignCall" 221 pp (TickBoxOpId _) = text "TickBoxOp" 222 pp (DFunId nt) = text "DFunId" <> ppWhen nt (text "(nt)") 223 pp (RecSelId { sel_naughty = is_naughty }) 224 = brackets $ text "RecSel" <> 225 ppWhen is_naughty (text "(naughty)") 226 pp CoVarId = text "CoVarId" 227 pp (JoinId arity) = text "JoinId" <> parens (int arity) 228 229{- 230************************************************************************ 231* * 232\subsection{The main IdInfo type} 233* * 234************************************************************************ 235-} 236 237-- | Identifier Information 238-- 239-- An 'IdInfo' gives /optional/ information about an 'Id'. If 240-- present it never lies, but it may not be present, in which case there 241-- is always a conservative assumption which can be made. 242-- 243-- Two 'Id's may have different info even though they have the same 244-- 'Unique' (and are hence the same 'Id'); for example, one might lack 245-- the properties attached to the other. 246-- 247-- Most of the 'IdInfo' gives information about the value, or definition, of 248-- the 'Id', independent of its usage. Exceptions to this 249-- are 'demandInfo', 'occInfo', 'oneShotInfo' and 'callArityInfo'. 250-- 251-- Performance note: when we update 'IdInfo', we have to reallocate this 252-- entire record, so it is a good idea not to let this data structure get 253-- too big. 254data IdInfo 255 = IdInfo { 256 ruleInfo :: RuleInfo, 257 -- ^ Specialisations of the 'Id's function which exist. 258 -- See Note [Specialisations and RULES in IdInfo] 259 unfoldingInfo :: Unfolding, 260 -- ^ The 'Id's unfolding 261 inlinePragInfo :: InlinePragma, 262 -- ^ Any inline pragma attached to the 'Id' 263 occInfo :: OccInfo, 264 -- ^ How the 'Id' occurs in the program 265 strictnessInfo :: StrictSig, 266 -- ^ A strictness signature. Digests how a function uses its arguments 267 -- if applied to at least 'arityInfo' arguments. 268 cprInfo :: CprSig, 269 -- ^ Information on whether the function will ultimately return a 270 -- freshly allocated constructor. 271 demandInfo :: Demand, 272 -- ^ ID demand information 273 bitfield :: {-# UNPACK #-} !BitField, 274 -- ^ Bitfield packs CafInfo, OneShotInfo, arity info, LevityInfo, and 275 -- call arity info in one 64-bit word. Packing these fields reduces size 276 -- of `IdInfo` from 12 words to 7 words and reduces residency by almost 277 -- 4% in some programs. See #17497 and associated MR. 278 -- 279 -- See documentation of the getters for what these packed fields mean. 280 lfInfo :: !(Maybe LambdaFormInfo) 281 } 282 283-- | Encodes arities, OneShotInfo, CafInfo and LevityInfo. 284-- From least-significant to most-significant bits: 285-- 286-- - Bit 0 (1): OneShotInfo 287-- - Bit 1 (1): CafInfo 288-- - Bit 2 (1): LevityInfo 289-- - Bits 3-32(30): Call Arity info 290-- - Bits 33-62(30): Arity info 291-- 292newtype BitField = BitField Word64 293 294emptyBitField :: BitField 295emptyBitField = BitField 0 296 297bitfieldGetOneShotInfo :: BitField -> OneShotInfo 298bitfieldGetOneShotInfo (BitField bits) = 299 if testBit bits 0 then OneShotLam else NoOneShotInfo 300 301bitfieldGetCafInfo :: BitField -> CafInfo 302bitfieldGetCafInfo (BitField bits) = 303 if testBit bits 1 then NoCafRefs else MayHaveCafRefs 304 305bitfieldGetLevityInfo :: BitField -> LevityInfo 306bitfieldGetLevityInfo (BitField bits) = 307 if testBit bits 2 then NeverLevityPolymorphic else NoLevityInfo 308 309bitfieldGetCallArityInfo :: BitField -> ArityInfo 310bitfieldGetCallArityInfo (BitField bits) = 311 fromIntegral (bits `shiftR` 3) .&. ((1 `shiftL` 30) - 1) 312 313bitfieldGetArityInfo :: BitField -> ArityInfo 314bitfieldGetArityInfo (BitField bits) = 315 fromIntegral (bits `shiftR` 33) 316 317bitfieldSetOneShotInfo :: OneShotInfo -> BitField -> BitField 318bitfieldSetOneShotInfo info (BitField bits) = 319 case info of 320 NoOneShotInfo -> BitField (clearBit bits 0) 321 OneShotLam -> BitField (setBit bits 0) 322 323bitfieldSetCafInfo :: CafInfo -> BitField -> BitField 324bitfieldSetCafInfo info (BitField bits) = 325 case info of 326 MayHaveCafRefs -> BitField (clearBit bits 1) 327 NoCafRefs -> BitField (setBit bits 1) 328 329bitfieldSetLevityInfo :: LevityInfo -> BitField -> BitField 330bitfieldSetLevityInfo info (BitField bits) = 331 case info of 332 NoLevityInfo -> BitField (clearBit bits 2) 333 NeverLevityPolymorphic -> BitField (setBit bits 2) 334 335bitfieldSetCallArityInfo :: ArityInfo -> BitField -> BitField 336bitfieldSetCallArityInfo info bf@(BitField bits) = 337 ASSERT(info < 2^(30 :: Int) - 1) 338 bitfieldSetArityInfo (bitfieldGetArityInfo bf) $ 339 BitField ((fromIntegral info `shiftL` 3) .|. (bits .&. 0b111)) 340 341bitfieldSetArityInfo :: ArityInfo -> BitField -> BitField 342bitfieldSetArityInfo info (BitField bits) = 343 ASSERT(info < 2^(30 :: Int) - 1) 344 BitField ((fromIntegral info `shiftL` 33) .|. (bits .&. ((1 `shiftL` 33) - 1))) 345 346-- Getters 347 348-- | When applied, will this Id ever have a levity-polymorphic type? 349levityInfo :: IdInfo -> LevityInfo 350levityInfo = bitfieldGetLevityInfo . bitfield 351 352-- | Info about a lambda-bound variable, if the 'Id' is one 353oneShotInfo :: IdInfo -> OneShotInfo 354oneShotInfo = bitfieldGetOneShotInfo . bitfield 355 356-- | 'Id' arity, as computed by "GHC.Core.Opt.Arity". Specifies how many arguments 357-- this 'Id' has to be applied to before it doesn any meaningful work. 358arityInfo :: IdInfo -> ArityInfo 359arityInfo = bitfieldGetArityInfo . bitfield 360 361-- | 'Id' CAF info 362cafInfo :: IdInfo -> CafInfo 363cafInfo = bitfieldGetCafInfo . bitfield 364 365-- | How this is called. This is the number of arguments to which a binding can 366-- be eta-expanded without losing any sharing. n <=> all calls have at least n 367-- arguments 368callArityInfo :: IdInfo -> ArityInfo 369callArityInfo = bitfieldGetCallArityInfo . bitfield 370 371-- Setters 372 373setRuleInfo :: IdInfo -> RuleInfo -> IdInfo 374setRuleInfo info sp = sp `seq` info { ruleInfo = sp } 375setInlinePragInfo :: IdInfo -> InlinePragma -> IdInfo 376setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr } 377setOccInfo :: IdInfo -> OccInfo -> IdInfo 378setOccInfo info oc = oc `seq` info { occInfo = oc } 379 -- Try to avoid space leaks by seq'ing 380 381setUnfoldingInfo :: IdInfo -> Unfolding -> IdInfo 382setUnfoldingInfo info uf 383 = -- We don't seq the unfolding, as we generate intermediate 384 -- unfoldings which are just thrown away, so evaluating them is a 385 -- waste of time. 386 -- seqUnfolding uf `seq` 387 info { unfoldingInfo = uf } 388 389setArityInfo :: IdInfo -> ArityInfo -> IdInfo 390setArityInfo info ar = 391 info { bitfield = bitfieldSetArityInfo ar (bitfield info) } 392 393setCallArityInfo :: IdInfo -> ArityInfo -> IdInfo 394setCallArityInfo info ar = 395 info { bitfield = bitfieldSetCallArityInfo ar (bitfield info) } 396 397setCafInfo :: IdInfo -> CafInfo -> IdInfo 398setCafInfo info caf = 399 info { bitfield = bitfieldSetCafInfo caf (bitfield info) } 400 401setLFInfo :: IdInfo -> LambdaFormInfo -> IdInfo 402setLFInfo info lf = info { lfInfo = Just lf } 403 404setOneShotInfo :: IdInfo -> OneShotInfo -> IdInfo 405setOneShotInfo info lb = 406 info { bitfield = bitfieldSetOneShotInfo lb (bitfield info) } 407 408setDemandInfo :: IdInfo -> Demand -> IdInfo 409setDemandInfo info dd = dd `seq` info { demandInfo = dd } 410 411setStrictnessInfo :: IdInfo -> StrictSig -> IdInfo 412setStrictnessInfo info dd = dd `seq` info { strictnessInfo = dd } 413 414setCprInfo :: IdInfo -> CprSig -> IdInfo 415setCprInfo info cpr = cpr `seq` info { cprInfo = cpr } 416 417-- | Basic 'IdInfo' that carries no useful information whatsoever 418vanillaIdInfo :: IdInfo 419vanillaIdInfo 420 = IdInfo { 421 ruleInfo = emptyRuleInfo, 422 unfoldingInfo = noUnfolding, 423 inlinePragInfo = defaultInlinePragma, 424 occInfo = noOccInfo, 425 demandInfo = topDmd, 426 strictnessInfo = nopSig, 427 cprInfo = topCprSig, 428 bitfield = bitfieldSetCafInfo vanillaCafInfo $ 429 bitfieldSetArityInfo unknownArity $ 430 bitfieldSetCallArityInfo unknownArity $ 431 bitfieldSetOneShotInfo NoOneShotInfo $ 432 bitfieldSetLevityInfo NoLevityInfo $ 433 emptyBitField, 434 lfInfo = Nothing 435 } 436 437-- | More informative 'IdInfo' we can use when we know the 'Id' has no CAF references 438noCafIdInfo :: IdInfo 439noCafIdInfo = vanillaIdInfo `setCafInfo` NoCafRefs 440 -- Used for built-in type Ids in GHC.Types.Id.Make. 441 442{- 443************************************************************************ 444* * 445\subsection[arity-IdInfo]{Arity info about an @Id@} 446* * 447************************************************************************ 448 449For locally-defined Ids, the code generator maintains its own notion 450of their arities; so it should not be asking... (but other things 451besides the code-generator need arity info!) 452-} 453 454-- | Arity Information 455-- 456-- An 'ArityInfo' of @n@ tells us that partial application of this 457-- 'Id' to up to @n-1@ value arguments does essentially no work. 458-- 459-- That is not necessarily the same as saying that it has @n@ leading 460-- lambdas, because coerces may get in the way. 461-- 462-- The arity might increase later in the compilation process, if 463-- an extra lambda floats up to the binding site. 464type ArityInfo = Arity 465 466-- | It is always safe to assume that an 'Id' has an arity of 0 467unknownArity :: Arity 468unknownArity = 0 469 470ppArityInfo :: Int -> SDoc 471ppArityInfo 0 = empty 472ppArityInfo n = hsep [text "Arity", int n] 473 474{- 475************************************************************************ 476* * 477\subsection{Inline-pragma information} 478* * 479************************************************************************ 480-} 481 482-- | Inline Pragma Information 483-- 484-- Tells when the inlining is active. 485-- When it is active the thing may be inlined, depending on how 486-- big it is. 487-- 488-- If there was an @INLINE@ pragma, then as a separate matter, the 489-- RHS will have been made to look small with a Core inline 'Note' 490-- 491-- The default 'InlinePragInfo' is 'AlwaysActive', so the info serves 492-- entirely as a way to inhibit inlining until we want it 493type InlinePragInfo = InlinePragma 494 495{- 496************************************************************************ 497* * 498 Strictness 499* * 500************************************************************************ 501-} 502 503pprStrictness :: StrictSig -> SDoc 504pprStrictness sig = ppr sig 505 506{- 507************************************************************************ 508* * 509 RuleInfo 510* * 511************************************************************************ 512 513Note [Specialisations and RULES in IdInfo] 514~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 515Generally speaking, a GlobalId has an *empty* RuleInfo. All their 516RULES are contained in the globally-built rule-base. In principle, 517one could attach the to M.f the RULES for M.f that are defined in M. 518But we don't do that for instance declarations and so we just treat 519them all uniformly. 520 521The EXCEPTION is PrimOpIds, which do have rules in their IdInfo. That is 522just for convenience really. 523 524However, LocalIds may have non-empty RuleInfo. We treat them 525differently because: 526 a) they might be nested, in which case a global table won't work 527 b) the RULE might mention free variables, which we use to keep things alive 528 529In GHC.Iface.Tidy, when the LocalId becomes a GlobalId, its RULES are stripped off 530and put in the global list. 531-} 532 533-- | Rule Information 534-- 535-- Records the specializations of this 'Id' that we know about 536-- in the form of rewrite 'CoreRule's that target them 537data RuleInfo 538 = RuleInfo 539 [CoreRule] 540 DVarSet -- Locally-defined free vars of *both* LHS and RHS 541 -- of rules. I don't think it needs to include the 542 -- ru_fn though. 543 -- Note [Rule dependency info] in "GHC.Core.Opt.OccurAnal" 544 545-- | Assume that no specializations exist: always safe 546emptyRuleInfo :: RuleInfo 547emptyRuleInfo = RuleInfo [] emptyDVarSet 548 549isEmptyRuleInfo :: RuleInfo -> Bool 550isEmptyRuleInfo (RuleInfo rs _) = null rs 551 552-- | Retrieve the locally-defined free variables of both the left and 553-- right hand sides of the specialization rules 554ruleInfoFreeVars :: RuleInfo -> DVarSet 555ruleInfoFreeVars (RuleInfo _ fvs) = fvs 556 557ruleInfoRules :: RuleInfo -> [CoreRule] 558ruleInfoRules (RuleInfo rules _) = rules 559 560-- | Change the name of the function the rule is keyed on all of the 'CoreRule's 561setRuleInfoHead :: Name -> RuleInfo -> RuleInfo 562setRuleInfoHead fn (RuleInfo rules fvs) 563 = RuleInfo (map (setRuleIdName fn) rules) fvs 564 565{- 566************************************************************************ 567* * 568\subsection[CG-IdInfo]{Code generator-related information} 569* * 570************************************************************************ 571-} 572 573-- CafInfo is used to build Static Reference Tables (see simplStg/SRT.hs). 574 575-- | Constant applicative form Information 576-- 577-- Records whether an 'Id' makes Constant Applicative Form references 578data CafInfo 579 = MayHaveCafRefs -- ^ Indicates that the 'Id' is for either: 580 -- 581 -- 1. A function or static constructor 582 -- that refers to one or more CAFs, or 583 -- 584 -- 2. A real live CAF 585 586 | NoCafRefs -- ^ A function or static constructor 587 -- that refers to no CAFs. 588 deriving (Eq, Ord) 589 590-- | Assumes that the 'Id' has CAF references: definitely safe 591vanillaCafInfo :: CafInfo 592vanillaCafInfo = MayHaveCafRefs 593 594mayHaveCafRefs :: CafInfo -> Bool 595mayHaveCafRefs MayHaveCafRefs = True 596mayHaveCafRefs _ = False 597 598instance Outputable CafInfo where 599 ppr = ppCafInfo 600 601ppCafInfo :: CafInfo -> SDoc 602ppCafInfo NoCafRefs = text "NoCafRefs" 603ppCafInfo MayHaveCafRefs = empty 604 605{- 606************************************************************************ 607* * 608\subsection{Bulk operations on IdInfo} 609* * 610************************************************************************ 611-} 612 613-- | This is used to remove information on lambda binders that we have 614-- setup as part of a lambda group, assuming they will be applied all at once, 615-- but turn out to be part of an unsaturated lambda as in e.g: 616-- 617-- > (\x1. \x2. e) arg1 618zapLamInfo :: IdInfo -> Maybe IdInfo 619zapLamInfo info@(IdInfo {occInfo = occ, demandInfo = demand}) 620 | is_safe_occ occ && is_safe_dmd demand 621 = Nothing 622 | otherwise 623 = Just (info {occInfo = safe_occ, demandInfo = topDmd}) 624 where 625 -- The "unsafe" occ info is the ones that say I'm not in a lambda 626 -- because that might not be true for an unsaturated lambda 627 is_safe_occ occ | isAlwaysTailCalled occ = False 628 is_safe_occ (OneOcc { occ_in_lam = NotInsideLam }) = False 629 is_safe_occ _other = True 630 631 safe_occ = case occ of 632 OneOcc{} -> occ { occ_in_lam = IsInsideLam 633 , occ_tail = NoTailCallInfo } 634 IAmALoopBreaker{} 635 -> occ { occ_tail = NoTailCallInfo } 636 _other -> occ 637 638 is_safe_dmd dmd = not (isStrUsedDmd dmd) 639 640-- | Remove all demand info on the 'IdInfo' 641zapDemandInfo :: IdInfo -> Maybe IdInfo 642zapDemandInfo info = Just (info {demandInfo = topDmd}) 643 644-- | Remove usage (but not strictness) info on the 'IdInfo' 645zapUsageInfo :: IdInfo -> Maybe IdInfo 646zapUsageInfo info = Just (info {demandInfo = zapUsageDemand (demandInfo info)}) 647 648-- | Remove usage environment info from the strictness signature on the 'IdInfo' 649zapUsageEnvInfo :: IdInfo -> Maybe IdInfo 650zapUsageEnvInfo info 651 | hasDemandEnvSig (strictnessInfo info) 652 = Just (info {strictnessInfo = zapDmdEnvSig (strictnessInfo info)}) 653 | otherwise 654 = Nothing 655 656zapUsedOnceInfo :: IdInfo -> Maybe IdInfo 657zapUsedOnceInfo info 658 = Just $ info { strictnessInfo = zapUsedOnceSig (strictnessInfo info) 659 , demandInfo = zapUsedOnceDemand (demandInfo info) } 660 661zapFragileInfo :: IdInfo -> Maybe IdInfo 662-- ^ Zap info that depends on free variables 663zapFragileInfo info@(IdInfo { occInfo = occ, unfoldingInfo = unf }) 664 = new_unf `seq` -- The unfolding field is not (currently) strict, so we 665 -- force it here to avoid a (zapFragileUnfolding unf) thunk 666 -- which might leak space 667 Just (info `setRuleInfo` emptyRuleInfo 668 `setUnfoldingInfo` new_unf 669 `setOccInfo` zapFragileOcc occ) 670 where 671 new_unf = zapFragileUnfolding unf 672 673zapFragileUnfolding :: Unfolding -> Unfolding 674zapFragileUnfolding unf 675 | hasCoreUnfolding unf = noUnfolding 676 | otherwise = unf 677 678zapUnfolding :: Unfolding -> Unfolding 679-- Squash all unfolding info, preserving only evaluated-ness 680zapUnfolding unf | isEvaldUnfolding unf = evaldUnfolding 681 | otherwise = noUnfolding 682 683zapTailCallInfo :: IdInfo -> Maybe IdInfo 684zapTailCallInfo info 685 = case occInfo info of 686 occ | isAlwaysTailCalled occ -> Just (info `setOccInfo` safe_occ) 687 | otherwise -> Nothing 688 where 689 safe_occ = occ { occ_tail = NoTailCallInfo } 690 691zapCallArityInfo :: IdInfo -> IdInfo 692zapCallArityInfo info = setCallArityInfo info 0 693 694{- 695************************************************************************ 696* * 697\subsection{TickBoxOp} 698* * 699************************************************************************ 700-} 701 702type TickBoxId = Int 703 704-- | Tick box for Hpc-style coverage 705data TickBoxOp 706 = TickBox Module {-# UNPACK #-} !TickBoxId 707 708instance Outputable TickBoxOp where 709 ppr (TickBox mod n) = text "tick" <+> ppr (mod,n) 710 711{- 712************************************************************************ 713* * 714 Levity 715* * 716************************************************************************ 717 718Note [Levity info] 719~~~~~~~~~~~~~~~~~~ 720 721Ids store whether or not they can be levity-polymorphic at any amount 722of saturation. This is helpful in optimizing the levity-polymorphism check 723done in the desugarer, where we can usually learn that something is not 724levity-polymorphic without actually figuring out its type. See 725isExprLevPoly in GHC.Core.Utils for where this info is used. Storing 726this is required to prevent perf/compiler/T5631 from blowing up. 727 728-} 729 730-- See Note [Levity info] 731data LevityInfo = NoLevityInfo -- always safe 732 | NeverLevityPolymorphic 733 deriving Eq 734 735instance Outputable LevityInfo where 736 ppr NoLevityInfo = text "NoLevityInfo" 737 ppr NeverLevityPolymorphic = text "NeverLevityPolymorphic" 738 739-- | Marks an IdInfo describing an Id that is never levity polymorphic (even when 740-- applied). The Type is only there for checking that it's really never levity 741-- polymorphic 742setNeverLevPoly :: HasDebugCallStack => IdInfo -> Type -> IdInfo 743setNeverLevPoly info ty 744 = ASSERT2( not (resultIsLevPoly ty), ppr ty ) 745 info { bitfield = bitfieldSetLevityInfo NeverLevityPolymorphic (bitfield info) } 746 747setLevityInfoWithType :: IdInfo -> Type -> IdInfo 748setLevityInfoWithType info ty 749 | not (resultIsLevPoly ty) 750 = info { bitfield = bitfieldSetLevityInfo NeverLevityPolymorphic (bitfield info) } 751 | otherwise 752 = info 753 754isNeverLevPolyIdInfo :: IdInfo -> Bool 755isNeverLevPolyIdInfo info 756 | NeverLevityPolymorphic <- levityInfo info = True 757 | otherwise = False 758