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