    {-
    (c) The University of Glasgow 2006
    (c) The GRASP/AQUA Project, Glasgow University, 1993-1998

    \section[IdInfo]{@IdInfos@: Non-essential information about @Ids@}

    (And a pretty good illustration of quite a few things wrong with
    Haskell. [WDP 94/11])
    -}

    {-# LANGUAGE CPP #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE BinaryLiterals #-}

    {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}

    module GHC.Types.Id.Info (
            -- * The IdDetails type
            IdDetails(..), pprIdDetails, coVarDetails, isCoVarDetails,
            JoinArity, isJoinIdDetails_maybe,
            RecSelParent(..),

            -- * The IdInfo type
            IdInfo,         -- Abstract
            vanillaIdInfo, noCafIdInfo,

            -- ** The OneShotInfo type
            OneShotInfo(..),
            oneShotInfo, noOneShotInfo, hasNoOneShotInfo,
            setOneShotInfo,

            -- ** Zapping various forms of Info
            zapLamInfo, zapFragileInfo,
            zapDemandInfo, zapUsageInfo, zapUsageEnvInfo, zapUsedOnceInfo,
            zapTailCallInfo, zapCallArityInfo, zapUnfolding,

            -- ** The ArityInfo type
            ArityInfo,
            unknownArity,
            arityInfo, setArityInfo, ppArityInfo,

            callArityInfo, setCallArityInfo,

            -- ** Demand and strictness Info
            strictnessInfo, setStrictnessInfo,
            cprInfo, setCprInfo,
            demandInfo, setDemandInfo, pprStrictness,

            -- ** Unfolding Info
            unfoldingInfo, setUnfoldingInfo,

            -- ** The InlinePragInfo type
            InlinePragInfo,
            inlinePragInfo, setInlinePragInfo,

            -- ** The OccInfo type
            OccInfo(..),
            isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker,
            occInfo, setOccInfo,

            InsideLam(..), BranchCount,

            TailCallInfo(..),
            tailCallInfo, isAlwaysTailCalled,

            -- ** The RuleInfo type
            RuleInfo(..),
            emptyRuleInfo,
            isEmptyRuleInfo, ruleInfoFreeVars,
            ruleInfoRules, setRuleInfoHead,
            ruleInfo, setRuleInfo,

            -- ** The CAFInfo type
            CafInfo(..),
            ppCafInfo, mayHaveCafRefs,
            cafInfo, setCafInfo,

            -- ** The LambdaFormInfo type
            LambdaFormInfo(..),
            lfInfo, setLFInfo,

            -- ** Tick-box Info
            TickBoxOp(..), TickBoxId,

            -- ** Levity info
            LevityInfo, levityInfo, setNeverLevPoly, setLevityInfoWithType,
            isNeverLevPolyIdInfo
        ) where

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.Core hiding( hasCoreUnfolding )
    import GHC.Core( hasCoreUnfolding )

    import GHC.Core.Class
    import {-# SOURCE #-} GHC.Builtin.PrimOps (PrimOp)
    import GHC.Types.Name
    import GHC.Types.Var.Set
    import GHC.Types.Basic
    import GHC.Core.DataCon
    import GHC.Core.TyCon
    import GHC.Core.PatSyn
    import GHC.Core.Type
    import GHC.Types.ForeignCall
    import GHC.Unit.Module
    import GHC.Types.Demand
    import GHC.Types.Cpr

    import GHC.Utils.Misc
    import GHC.Utils.Outputable
    import GHC.Utils.Panic

    import Data.Word

    import GHC.StgToCmm.Types (LambdaFormInfo (..))

    -- infixl so you can say (id `set` a `set` b)
    infixl  1 `setRuleInfo`,
              `setArityInfo`,
              `setInlinePragInfo`,
              `setUnfoldingInfo`,
              `setOneShotInfo`,
              `setOccInfo`,
              `setCafInfo`,
              `setStrictnessInfo`,
              `setCprInfo`,
              `setDemandInfo`,
              `setNeverLevPoly`,
              `setLevityInfoWithType`

    {-
    ************************************************************************
    *                                                                      *
                         IdDetails
    *                                                                      *
    ************************************************************************
    -}

    -- | Identifier Details
    --
    -- The 'IdDetails' of an 'Id' give stable, and necessary,
    -- information about the Id.
    data IdDetails
      = VanillaId

      -- | The 'Id' for a record selector
      | RecSelId
        { IdDetails -> RecSelParent
    sel_tycon   :: RecSelParent
        , IdDetails -> Bool
    sel_naughty :: Bool       -- True <=> a "naughty" selector which can't actually exist, for example @x@ in:
                                    --    data T = forall a. MkT { x :: a }
        }                           -- See Note [Naughty record selectors] in GHC.Tc.TyCl

      | DataConWorkId DataCon       -- ^ The 'Id' is for a data constructor /worker/
      | DataConWrapId DataCon       -- ^ The 'Id' is for a data constructor /wrapper/

                                    -- [the only reasons we need to know is so that
                                    --  a) to support isImplicitId
                                    --  b) when desugaring a RecordCon we can get
                                    --     from the Id back to the data con]
      | ClassOpId Class             -- ^ The 'Id' is a superclass selector,
                                    -- or class operation of a class

      | PrimOpId PrimOp             -- ^ The 'Id' is for a primitive operator
      | FCallId ForeignCall         -- ^ The 'Id' is for a foreign call.
                                    -- Type will be simple: no type families, newtypes, etc

      | TickBoxOpId TickBoxOp       -- ^ The 'Id' is for a HPC tick box (both traditional and binary)

      | DFunId Bool                 -- ^ A dictionary function.
           -- Bool = True <=> the class has only one method, so may be
           --                  implemented with a newtype, so it might be bad
           --                  to be strict on this dictionary

      | CoVarId    -- ^ A coercion variable
                   -- This only covers /un-lifted/ coercions, of type
                   -- (t1 ~# t2) or (t1 ~R# t2), not their lifted variants
      | JoinId JoinArity           -- ^ An 'Id' for a join point taking n arguments
           -- Note [Join points] in "GHC.Core"

    -- | Recursive Selector Parent
    data RecSelParent = RecSelData TyCon | RecSelPatSyn PatSyn deriving RecSelParent -> RecSelParent -> Bool
    (RecSelParent -> RecSelParent -> Bool)
    -> (RecSelParent -> RecSelParent -> Bool) -> Eq RecSelParent
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: RecSelParent -> RecSelParent -> Bool
    $c/= :: RecSelParent -> RecSelParent -> Bool
    == :: RecSelParent -> RecSelParent -> Bool
    $c== :: RecSelParent -> RecSelParent -> Bool
    Eq
      -- Either `TyCon` or `PatSyn` depending
      -- on the origin of the record selector.
      -- For a data type family, this is the
      -- /instance/ 'TyCon' not the family 'TyCon'

    instance Outputable RecSelParent where
      ppr :: RecSelParent -> SDoc
    ppr RecSelParent
    p = case RecSelParent
    p of
                RecSelData TyCon
    ty_con -> TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    ty_con
                RecSelPatSyn PatSyn
    ps   -> PatSyn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr PatSyn
    ps

    -- | Just a synonym for 'CoVarId'. Written separately so it can be
    -- exported in the hs-boot file.
    coVarDetails :: IdDetails
    coVarDetails :: IdDetails
    coVarDetails = IdDetails
    CoVarId

    -- | Check if an 'IdDetails' says 'CoVarId'.
    isCoVarDetails :: IdDetails -> Bool
    isCoVarDetails :: IdDetails -> Bool
    isCoVarDetails IdDetails
    CoVarId = Bool
    True
    isCoVarDetails IdDetails
    _       = Bool
    False

    isJoinIdDetails_maybe :: IdDetails -> Maybe JoinArity
    isJoinIdDetails_maybe :: IdDetails -> Maybe Int
    isJoinIdDetails_maybe (JoinId Int
    join_arity) = Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    join_arity
    isJoinIdDetails_maybe IdDetails
    _                   = Maybe Int
    forall a. Maybe a
    Nothing

    instance Outputable IdDetails where
        ppr :: IdDetails -> SDoc
    ppr = IdDetails -> SDoc
    pprIdDetails

    pprIdDetails :: IdDetails -> SDoc
    pprIdDetails :: IdDetails -> SDoc
    pprIdDetails IdDetails
    VanillaId = SDoc
    empty
    pprIdDetails IdDetails
    other     = SDoc -> SDoc
    brackets (IdDetails -> SDoc
    pp IdDetails
    other)
     where
       pp :: IdDetails -> SDoc
    pp IdDetails
    VanillaId               = String -> SDoc
    forall a. String -> a
    panic String
    "pprIdDetails"
       pp (DataConWorkId DataCon
    _)       = String -> SDoc
    text String
    "DataCon"
       pp (DataConWrapId DataCon
    _)       = String -> SDoc
    text String
    "DataConWrapper"
       pp (ClassOpId {})          = String -> SDoc
    text String
    "ClassOp"
       pp (PrimOpId PrimOp
    _)            = String -> SDoc
    text String
    "PrimOp"
       pp (FCallId ForeignCall
    _)             = String -> SDoc
    text String
    "ForeignCall"
       pp (TickBoxOpId TickBoxOp
    _)         = String -> SDoc
    text String
    "TickBoxOp"
       pp (DFunId Bool
    nt)             = String -> SDoc
    text String
    "DFunId" SDoc -> SDoc -> SDoc
    <> Bool -> SDoc -> SDoc
    ppWhen Bool
    nt (String -> SDoc
    text String
    "(nt)")
       pp (RecSelId { sel_naughty :: IdDetails -> Bool
    sel_naughty = Bool
    is_naughty })
                                  = SDoc -> SDoc
    brackets (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "RecSel" SDoc -> SDoc -> SDoc
    <>
                                               Bool -> SDoc -> SDoc
    ppWhen Bool
    is_naughty (String -> SDoc
    text String
    "(naughty)")
       pp IdDetails
    CoVarId                 = String -> SDoc
    text String
    "CoVarId"
       pp (JoinId Int
    arity)          = String -> SDoc
    text String
    "JoinId" SDoc -> SDoc -> SDoc
    <> SDoc -> SDoc
    parens (Int -> SDoc
    int Int
    arity)

    {-
    ************************************************************************
    *                                                                      *
    \subsection{The main IdInfo type}
    *                                                                      *
    ************************************************************************
    -}

    -- | Identifier Information
    --
    -- An 'IdInfo' gives /optional/ information about an 'Id'.  If
    -- present it never lies, but it may not be present, in which case there
    -- is always a conservative assumption which can be made.
    --
    -- Two 'Id's may have different info even though they have the same
    -- 'Unique' (and are hence the same 'Id'); for example, one might lack
    -- the properties attached to the other.
    --
    -- Most of the 'IdInfo' gives information about the value, or definition, of
    -- the 'Id', independent of its usage. Exceptions to this
    -- are 'demandInfo', 'occInfo', 'oneShotInfo' and 'callArityInfo'.
    --
    -- Performance note: when we update 'IdInfo', we have to reallocate this
    -- entire record, so it is a good idea not to let this data structure get
    -- too big.
    data IdInfo
      = IdInfo {
            IdInfo -> RuleInfo
    ruleInfo        :: RuleInfo,
            -- ^ Specialisations of the 'Id's function which exist.
            -- See Note [Specialisations and RULES in IdInfo]
            IdInfo -> Unfolding
    unfoldingInfo   :: Unfolding,
            -- ^ The 'Id's unfolding
            IdInfo -> InlinePragma
    inlinePragInfo  :: InlinePragma,
            -- ^ Any inline pragma attached to the 'Id'
            IdInfo -> OccInfo
    occInfo         :: OccInfo,
            -- ^ How the 'Id' occurs in the program
            IdInfo -> StrictSig
    strictnessInfo  :: StrictSig,
            -- ^ A strictness signature. Digests how a function uses its arguments
            -- if applied to at least 'arityInfo' arguments.
            IdInfo -> CprSig
    cprInfo         :: CprSig,
            -- ^ Information on whether the function will ultimately return a
            -- freshly allocated constructor.
            IdInfo -> Demand
    demandInfo      :: Demand,
            -- ^ ID demand information
            IdInfo -> BitField
    bitfield        :: {-# UNPACK #-} !BitField,
            -- ^ Bitfield packs CafInfo, OneShotInfo, arity info, LevityInfo, and
            -- call arity info in one 64-bit word. Packing these fields reduces size
            -- of `IdInfo` from 12 words to 7 words and reduces residency by almost
            -- 4% in some programs. See #17497 and associated MR.
            --
            -- See documentation of the getters for what these packed fields mean.
            IdInfo -> Maybe LambdaFormInfo
    lfInfo          :: !(Maybe LambdaFormInfo)
        }

    -- | Encodes arities, OneShotInfo, CafInfo and LevityInfo.
    -- From least-significant to most-significant bits:
    --
    -- - Bit   0   (1):  OneShotInfo
    -- - Bit   1   (1):  CafInfo
    -- - Bit   2   (1):  LevityInfo
    -- - Bits  3-32(30): Call Arity info
    -- - Bits 33-62(30): Arity info
    --
    newtype BitField = BitField Word64

    emptyBitField :: BitField
    emptyBitField :: BitField
    emptyBitField = Word64 -> BitField
    BitField Word64
    0

    bitfieldGetOneShotInfo :: BitField -> OneShotInfo
    bitfieldGetOneShotInfo :: BitField -> OneShotInfo
    bitfieldGetOneShotInfo (BitField Word64
    bits) =
        if Word64 -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    testBit Word64
    bits Int
    0 then OneShotInfo
    OneShotLam else OneShotInfo
    NoOneShotInfo

    bitfieldGetCafInfo :: BitField -> CafInfo
    bitfieldGetCafInfo :: BitField -> CafInfo
    bitfieldGetCafInfo (BitField Word64
    bits) =
        if Word64 -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    testBit Word64
    bits Int
    1 then CafInfo
    NoCafRefs else CafInfo
    MayHaveCafRefs

    bitfieldGetLevityInfo :: BitField -> LevityInfo
    bitfieldGetLevityInfo :: BitField -> LevityInfo
    bitfieldGetLevityInfo (BitField Word64
    bits) =
        if Word64 -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    testBit Word64
    bits Int
    2 then LevityInfo
    NeverLevityPolymorphic else LevityInfo
    NoLevityInfo

    bitfieldGetCallArityInfo :: BitField -> ArityInfo
    bitfieldGetCallArityInfo :: BitField -> Int
    bitfieldGetCallArityInfo (BitField Word64
    bits) =
        Word64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64
    bits Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    3) Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .&. ((Int
    1 Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    30) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)

    bitfieldGetArityInfo :: BitField -> ArityInfo
    bitfieldGetArityInfo :: BitField -> Int
    bitfieldGetArityInfo (BitField Word64
    bits) =
        Word64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64
    bits Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    33)

    bitfieldSetOneShotInfo :: OneShotInfo -> BitField -> BitField
    bitfieldSetOneShotInfo :: OneShotInfo -> BitField -> BitField
    bitfieldSetOneShotInfo OneShotInfo
    info (BitField Word64
    bits) =
        case OneShotInfo
    info of
          OneShotInfo
    NoOneShotInfo -> Word64 -> BitField
    BitField (Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    clearBit Word64
    bits Int
    0)
          OneShotInfo
    OneShotLam -> Word64 -> BitField
    BitField (Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    setBit Word64
    bits Int
    0)

    bitfieldSetCafInfo :: CafInfo -> BitField -> BitField
    bitfieldSetCafInfo :: CafInfo -> BitField -> BitField
    bitfieldSetCafInfo CafInfo
    info (BitField Word64
    bits) =
        case CafInfo
    info of
          CafInfo
    MayHaveCafRefs -> Word64 -> BitField
    BitField (Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    clearBit Word64
    bits Int
    1)
          CafInfo
    NoCafRefs -> Word64 -> BitField
    BitField (Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    setBit Word64
    bits Int
    1)

    bitfieldSetLevityInfo :: LevityInfo -> BitField -> BitField
    bitfieldSetLevityInfo :: LevityInfo -> BitField -> BitField
    bitfieldSetLevityInfo LevityInfo
    info (BitField Word64
    bits) =
        case LevityInfo
    info of
          LevityInfo
    NoLevityInfo -> Word64 -> BitField
    BitField (Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    clearBit Word64
    bits Int
    2)
          LevityInfo
    NeverLevityPolymorphic -> Word64 -> BitField
    BitField (Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    setBit Word64
    bits Int
    2)

    bitfieldSetCallArityInfo :: ArityInfo -> BitField -> BitField
    bitfieldSetCallArityInfo :: Int -> BitField -> BitField
    bitfieldSetCallArityInfo Int
    info bf :: BitField
    bf@(BitField Word64
    bits) =
        ASSERT(info < 2^(30 :: Int) - 1)
        Int -> BitField -> BitField
    bitfieldSetArityInfo (BitField -> Int
    bitfieldGetArityInfo BitField
    bf) (BitField -> BitField) -> BitField -> BitField
    forall a b. (a -> b) -> a -> b
    $
        Word64 -> BitField
    BitField ((Int -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    info Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    3) Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .|. (Word64
    bits Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .&. Word64
    0b111))

    bitfieldSetArityInfo :: ArityInfo -> BitField -> BitField
    bitfieldSetArityInfo :: Int -> BitField -> BitField
    bitfieldSetArityInfo Int
    info (BitField Word64
    bits) =
        ASSERT(info < 2^(30 :: Int) - 1)
        Word64 -> BitField
    BitField ((Int -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    info Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    33) Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .|. (Word64
    bits Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .&. ((Word64
    1 Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    33) Word64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    - Word64
    1)))

    -- Getters

    -- | When applied, will this Id ever have a levity-polymorphic type?
    levityInfo :: IdInfo -> LevityInfo
    levityInfo :: IdInfo -> LevityInfo
    levityInfo = BitField -> LevityInfo
    bitfieldGetLevityInfo (BitField -> LevityInfo)
    -> (IdInfo -> BitField) -> IdInfo -> LevityInfo
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IdInfo -> BitField
    bitfield

    -- | Info about a lambda-bound variable, if the 'Id' is one
    oneShotInfo :: IdInfo -> OneShotInfo
    oneShotInfo :: IdInfo -> OneShotInfo
    oneShotInfo = BitField -> OneShotInfo
    bitfieldGetOneShotInfo (BitField -> OneShotInfo)
    -> (IdInfo -> BitField) -> IdInfo -> OneShotInfo
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IdInfo -> BitField
    bitfield

    -- | 'Id' arity, as computed by "GHC.Core.Opt.Arity". Specifies how many arguments
    -- this 'Id' has to be applied to before it doesn any meaningful work.
    arityInfo :: IdInfo -> ArityInfo
    arityInfo :: IdInfo -> Int
    arityInfo = BitField -> Int
    bitfieldGetArityInfo (BitField -> Int) -> (IdInfo -> BitField) -> IdInfo -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IdInfo -> BitField
    bitfield

    -- | 'Id' CAF info
    cafInfo :: IdInfo -> CafInfo
    cafInfo :: IdInfo -> CafInfo
    cafInfo = BitField -> CafInfo
    bitfieldGetCafInfo (BitField -> CafInfo) -> (IdInfo -> BitField) -> IdInfo -> CafInfo
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IdInfo -> BitField
    bitfield

    -- | How this is called. This is the number of arguments to which a binding can
    -- be eta-expanded without losing any sharing. n <=> all calls have at least n
    -- arguments
    callArityInfo :: IdInfo -> ArityInfo
    callArityInfo :: IdInfo -> Int
    callArityInfo = BitField -> Int
    bitfieldGetCallArityInfo (BitField -> Int) -> (IdInfo -> BitField) -> IdInfo -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IdInfo -> BitField
    bitfield

    -- Setters

    setRuleInfo :: IdInfo -> RuleInfo -> IdInfo
    setRuleInfo :: IdInfo -> RuleInfo -> IdInfo
    setRuleInfo       IdInfo
    info RuleInfo
    sp = RuleInfo
    sp RuleInfo -> IdInfo -> IdInfo
    `seq` IdInfo
    info { ruleInfo :: RuleInfo
    ruleInfo = RuleInfo
    sp }
    setInlinePragInfo :: IdInfo -> InlinePragma -> IdInfo
    setInlinePragInfo :: IdInfo -> InlinePragma -> IdInfo
    setInlinePragInfo IdInfo
    info InlinePragma
    pr = InlinePragma
    pr InlinePragma -> IdInfo -> IdInfo
    `seq` IdInfo
    info { inlinePragInfo :: InlinePragma
    inlinePragInfo = InlinePragma
    pr }
    setOccInfo :: IdInfo -> OccInfo -> IdInfo
    setOccInfo :: IdInfo -> OccInfo -> IdInfo
    setOccInfo        IdInfo
    info OccInfo
    oc = OccInfo
    oc OccInfo -> IdInfo -> IdInfo
    `seq` IdInfo
    info { occInfo :: OccInfo
    occInfo = OccInfo
    oc }
            -- Try to avoid space leaks by seq'ing

    setUnfoldingInfo :: IdInfo -> Unfolding -> IdInfo
    setUnfoldingInfo :: IdInfo -> Unfolding -> IdInfo
    setUnfoldingInfo IdInfo
    info Unfolding
    uf
      = -- We don't seq the unfolding, as we generate intermediate
        -- unfoldings which are just thrown away, so evaluating them is a
        -- waste of time.
        -- seqUnfolding uf `seq`
        IdInfo
    info { unfoldingInfo :: Unfolding
    unfoldingInfo = Unfolding
    uf }

    setArityInfo :: IdInfo -> ArityInfo -> IdInfo
    setArityInfo :: IdInfo -> Int -> IdInfo
    setArityInfo IdInfo
    info Int
    ar =
        IdInfo
    info { bitfield :: BitField
    bitfield = Int -> BitField -> BitField
    bitfieldSetArityInfo Int
    ar (IdInfo -> BitField
    bitfield IdInfo
    info) }

    setCallArityInfo :: IdInfo -> ArityInfo -> IdInfo
    setCallArityInfo :: IdInfo -> Int -> IdInfo
    setCallArityInfo IdInfo
    info Int
    ar =
        IdInfo
    info { bitfield :: BitField
    bitfield = Int -> BitField -> BitField
    bitfieldSetCallArityInfo Int
    ar (IdInfo -> BitField
    bitfield IdInfo
    info) }

    setCafInfo :: IdInfo -> CafInfo -> IdInfo
    setCafInfo :: IdInfo -> CafInfo -> IdInfo
    setCafInfo IdInfo
    info CafInfo
    caf =
        IdInfo
    info { bitfield :: BitField
    bitfield = CafInfo -> BitField -> BitField
    bitfieldSetCafInfo CafInfo
    caf (IdInfo -> BitField
    bitfield IdInfo
    info) }

    setLFInfo :: IdInfo -> LambdaFormInfo -> IdInfo
    setLFInfo :: IdInfo -> LambdaFormInfo -> IdInfo
    setLFInfo IdInfo
    info LambdaFormInfo
    lf = IdInfo
    info { lfInfo :: Maybe LambdaFormInfo
    lfInfo = LambdaFormInfo -> Maybe LambdaFormInfo
    forall a. a -> Maybe a
    Just LambdaFormInfo
    lf }

    setOneShotInfo :: IdInfo -> OneShotInfo -> IdInfo
    setOneShotInfo :: IdInfo -> OneShotInfo -> IdInfo
    setOneShotInfo IdInfo
    info OneShotInfo
    lb =
        IdInfo
    info { bitfield :: BitField
    bitfield = OneShotInfo -> BitField -> BitField
    bitfieldSetOneShotInfo OneShotInfo
    lb (IdInfo -> BitField
    bitfield IdInfo
    info) }

    setDemandInfo :: IdInfo -> Demand -> IdInfo
    setDemandInfo :: IdInfo -> Demand -> IdInfo
    setDemandInfo IdInfo
    info Demand
    dd = Demand
    dd Demand -> IdInfo -> IdInfo
    `seq` IdInfo
    info { demandInfo :: Demand
    demandInfo = Demand
    dd }

    setStrictnessInfo :: IdInfo -> StrictSig -> IdInfo
    setStrictnessInfo :: IdInfo -> StrictSig -> IdInfo
    setStrictnessInfo IdInfo
    info StrictSig
    dd = StrictSig
    dd StrictSig -> IdInfo -> IdInfo
    `seq` IdInfo
    info { strictnessInfo :: StrictSig
    strictnessInfo = StrictSig
    dd }

    setCprInfo :: IdInfo -> CprSig -> IdInfo
    setCprInfo :: IdInfo -> CprSig -> IdInfo
    setCprInfo IdInfo
    info CprSig
    cpr = CprSig
    cpr CprSig -> IdInfo -> IdInfo
    `seq` IdInfo
    info { cprInfo :: CprSig
    cprInfo = CprSig
    cpr }

    -- | Basic 'IdInfo' that carries no useful information whatsoever
    vanillaIdInfo :: IdInfo
    vanillaIdInfo :: IdInfo
    vanillaIdInfo
      = IdInfo {
                ruleInfo :: RuleInfo
    ruleInfo            = RuleInfo
    emptyRuleInfo,
                unfoldingInfo :: Unfolding
    unfoldingInfo       = Unfolding
    noUnfolding,
                inlinePragInfo :: InlinePragma
    inlinePragInfo      = InlinePragma
    defaultInlinePragma,
                occInfo :: OccInfo
    occInfo             = OccInfo
    noOccInfo,
                demandInfo :: Demand
    demandInfo          = Demand
    topDmd,
                strictnessInfo :: StrictSig
    strictnessInfo      = StrictSig
    nopSig,
                cprInfo :: CprSig
    cprInfo             = CprSig
    topCprSig,
                bitfield :: BitField
    bitfield            = CafInfo -> BitField -> BitField
    bitfieldSetCafInfo CafInfo
    vanillaCafInfo (BitField -> BitField) -> BitField -> BitField
    forall a b. (a -> b) -> a -> b
    $
                                      Int -> BitField -> BitField
    bitfieldSetArityInfo Int
    unknownArity (BitField -> BitField) -> BitField -> BitField
    forall a b. (a -> b) -> a -> b
    $
                                      Int -> BitField -> BitField
    bitfieldSetCallArityInfo Int
    unknownArity (BitField -> BitField) -> BitField -> BitField
    forall a b. (a -> b) -> a -> b
    $
                                      OneShotInfo -> BitField -> BitField
    bitfieldSetOneShotInfo OneShotInfo
    NoOneShotInfo (BitField -> BitField) -> BitField -> BitField
    forall a b. (a -> b) -> a -> b
    $
                                      LevityInfo -> BitField -> BitField
    bitfieldSetLevityInfo LevityInfo
    NoLevityInfo (BitField -> BitField) -> BitField -> BitField
    forall a b. (a -> b) -> a -> b
    $
                                      BitField
    emptyBitField,
                lfInfo :: Maybe LambdaFormInfo
    lfInfo              = Maybe LambdaFormInfo
    forall a. Maybe a
    Nothing
               }

    -- | More informative 'IdInfo' we can use when we know the 'Id' has no CAF references
    noCafIdInfo :: IdInfo
    noCafIdInfo :: IdInfo
    noCafIdInfo  = IdInfo
    vanillaIdInfo IdInfo -> CafInfo -> IdInfo
    `setCafInfo`    CafInfo
    NoCafRefs
            -- Used for built-in type Ids in GHC.Types.Id.Make.

    {-
    ************************************************************************
    *                                                                      *
    \subsection[arity-IdInfo]{Arity info about an @Id@}
    *                                                                      *
    ************************************************************************

    For locally-defined Ids, the code generator maintains its own notion
    of their arities; so it should not be asking...  (but other things
    besides the code-generator need arity info!)
    -}

    -- | Arity Information
    --
    -- An 'ArityInfo' of @n@ tells us that partial application of this
    -- 'Id' to up to @n-1@ value arguments does essentially no work.
    --
    -- That is not necessarily the same as saying that it has @n@ leading
    -- lambdas, because coerces may get in the way.
    --
    -- The arity might increase later in the compilation process, if
    -- an extra lambda floats up to the binding site.
    type ArityInfo = Arity

    -- | It is always safe to assume that an 'Id' has an arity of 0
    unknownArity :: Arity
    unknownArity :: Int
    unknownArity = Int
    0

    ppArityInfo :: Int -> SDoc
    ppArityInfo :: Int -> SDoc
    ppArityInfo Int
    0 = SDoc
    empty
    ppArityInfo Int
    n = [SDoc] -> SDoc
    hsep [String -> SDoc
    text String
    "Arity", Int -> SDoc
    int Int
    n]

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Inline-pragma information}
    *                                                                      *
    ************************************************************************
    -}

    -- | Inline Pragma Information
    --
    -- Tells when the inlining is active.
    -- When it is active the thing may be inlined, depending on how
    -- big it is.
    --
    -- If there was an @INLINE@ pragma, then as a separate matter, the
    -- RHS will have been made to look small with a Core inline 'Note'
    --
    -- The default 'InlinePragInfo' is 'AlwaysActive', so the info serves
    -- entirely as a way to inhibit inlining until we want it
    type InlinePragInfo = InlinePragma

    {-
    ************************************************************************
    *                                                                      *
                   Strictness
    *                                                                      *
    ************************************************************************
    -}

    pprStrictness :: StrictSig -> SDoc
    pprStrictness :: StrictSig -> SDoc
    pprStrictness StrictSig
    sig = StrictSig -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr StrictSig
    sig

    {-
    ************************************************************************
    *                                                                      *
            RuleInfo
    *                                                                      *
    ************************************************************************

    Note [Specialisations and RULES in IdInfo]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Generally speaking, a GlobalId has an *empty* RuleInfo.  All their
    RULES are contained in the globally-built rule-base.  In principle,
    one could attach the to M.f the RULES for M.f that are defined in M.
    But we don't do that for instance declarations and so we just treat
    them all uniformly.

    The EXCEPTION is PrimOpIds, which do have rules in their IdInfo. That is
    just for convenience really.

    However, LocalIds may have non-empty RuleInfo.  We treat them
    differently because:
      a) they might be nested, in which case a global table won't work
      b) the RULE might mention free variables, which we use to keep things alive

    In GHC.Iface.Tidy, when the LocalId becomes a GlobalId, its RULES are stripped off
    and put in the global list.
    -}

    -- | Rule Information
    --
    -- Records the specializations of this 'Id' that we know about
    -- in the form of rewrite 'CoreRule's that target them
    data RuleInfo
      = RuleInfo
            [CoreRule]
            DVarSet         -- Locally-defined free vars of *both* LHS and RHS
                            -- of rules.  I don't think it needs to include the
                            -- ru_fn though.
                            -- Note [Rule dependency info] in "GHC.Core.Opt.OccurAnal"

    -- | Assume that no specializations exist: always safe
    emptyRuleInfo :: RuleInfo
    emptyRuleInfo :: RuleInfo
    emptyRuleInfo = [CoreRule] -> DVarSet -> RuleInfo
    RuleInfo [] DVarSet
    emptyDVarSet

    isEmptyRuleInfo :: RuleInfo -> Bool
    isEmptyRuleInfo :: RuleInfo -> Bool
    isEmptyRuleInfo (RuleInfo [CoreRule]
    rs DVarSet
    _) = [CoreRule] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [CoreRule]
    rs

    -- | Retrieve the locally-defined free variables of both the left and
    -- right hand sides of the specialization rules
    ruleInfoFreeVars :: RuleInfo -> DVarSet
    ruleInfoFreeVars :: RuleInfo -> DVarSet
    ruleInfoFreeVars (RuleInfo [CoreRule]
    _ DVarSet
    fvs) = DVarSet
    fvs

    ruleInfoRules :: RuleInfo -> [CoreRule]
    ruleInfoRules :: RuleInfo -> [CoreRule]
    ruleInfoRules (RuleInfo [CoreRule]
    rules DVarSet
    _) = [CoreRule]
    rules

    -- | Change the name of the function the rule is keyed on all of the 'CoreRule's
    setRuleInfoHead :: Name -> RuleInfo -> RuleInfo
    setRuleInfoHead :: Name -> RuleInfo -> RuleInfo
    setRuleInfoHead Name
    fn (RuleInfo [CoreRule]
    rules DVarSet
    fvs)
      = [CoreRule] -> DVarSet -> RuleInfo
    RuleInfo ((CoreRule -> CoreRule) -> [CoreRule] -> [CoreRule]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name -> CoreRule -> CoreRule
    setRuleIdName Name
    fn) [CoreRule]
    rules) DVarSet
    fvs

    {-
    ************************************************************************
    *                                                                      *
    \subsection[CG-IdInfo]{Code generator-related information}
    *                                                                      *
    ************************************************************************
    -}

    -- CafInfo is used to build Static Reference Tables (see simplStg/SRT.hs).

    -- | Constant applicative form Information
    --
    -- Records whether an 'Id' makes Constant Applicative Form references
    data CafInfo
            = MayHaveCafRefs                -- ^ Indicates that the 'Id' is for either:
                                            --
                                            -- 1. A function or static constructor
                                            --    that refers to one or more CAFs, or
                                            --
                                            -- 2. A real live CAF

            | NoCafRefs                     -- ^ A function or static constructor
                                            -- that refers to no CAFs.
            deriving (CafInfo -> CafInfo -> Bool
    (CafInfo -> CafInfo -> Bool)
    -> (CafInfo -> CafInfo -> Bool) -> Eq CafInfo
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: CafInfo -> CafInfo -> Bool
    $c/= :: CafInfo -> CafInfo -> Bool
    == :: CafInfo -> CafInfo -> Bool
    $c== :: CafInfo -> CafInfo -> Bool
    Eq, Eq CafInfo
    Eq CafInfo
    -> (CafInfo -> CafInfo -> Ordering)
    -> (CafInfo -> CafInfo -> Bool)
    -> (CafInfo -> CafInfo -> Bool)
    -> (CafInfo -> CafInfo -> Bool)
    -> (CafInfo -> CafInfo -> Bool)
    -> (CafInfo -> CafInfo -> CafInfo)
    -> (CafInfo -> CafInfo -> CafInfo)
    -> Ord CafInfo
    CafInfo -> CafInfo -> Bool
    CafInfo -> CafInfo -> Ordering
    CafInfo -> CafInfo -> CafInfo
    forall a.
    Eq a
    -> (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    min :: CafInfo -> CafInfo -> CafInfo
    $cmin :: CafInfo -> CafInfo -> CafInfo
    max :: CafInfo -> CafInfo -> CafInfo
    $cmax :: CafInfo -> CafInfo -> CafInfo
    >= :: CafInfo -> CafInfo -> Bool
    $c>= :: CafInfo -> CafInfo -> Bool
    > :: CafInfo -> CafInfo -> Bool
    $c> :: CafInfo -> CafInfo -> Bool
    <= :: CafInfo -> CafInfo -> Bool
    $c<= :: CafInfo -> CafInfo -> Bool
    < :: CafInfo -> CafInfo -> Bool
    $c< :: CafInfo -> CafInfo -> Bool
    compare :: CafInfo -> CafInfo -> Ordering
    $ccompare :: CafInfo -> CafInfo -> Ordering
    Ord)

    -- | Assumes that the 'Id' has CAF references: definitely safe
    vanillaCafInfo :: CafInfo
    vanillaCafInfo :: CafInfo
    vanillaCafInfo = CafInfo
    MayHaveCafRefs

    mayHaveCafRefs :: CafInfo -> Bool
    mayHaveCafRefs :: CafInfo -> Bool
    mayHaveCafRefs  CafInfo
    MayHaveCafRefs = Bool
    True
    mayHaveCafRefs CafInfo
    _               = Bool
    False

    instance Outputable CafInfo where
       ppr :: CafInfo -> SDoc
    ppr = CafInfo -> SDoc
    ppCafInfo

    ppCafInfo :: CafInfo -> SDoc
    ppCafInfo :: CafInfo -> SDoc
    ppCafInfo CafInfo
    NoCafRefs = String -> SDoc
    text String
    "NoCafRefs"
    ppCafInfo CafInfo
    MayHaveCafRefs = SDoc
    empty

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Bulk operations on IdInfo}
    *                                                                      *
    ************************************************************************
    -}

    -- | This is used to remove information on lambda binders that we have
    -- setup as part of a lambda group, assuming they will be applied all at once,
    -- but turn out to be part of an unsaturated lambda as in e.g:
    --
    -- > (\x1. \x2. e) arg1
    zapLamInfo :: IdInfo -> Maybe IdInfo
    zapLamInfo :: IdInfo -> Maybe IdInfo
    zapLamInfo info :: IdInfo
    info@(IdInfo {occInfo :: IdInfo -> OccInfo
    occInfo = OccInfo
    occ, demandInfo :: IdInfo -> Demand
    demandInfo = Demand
    demand})
      | OccInfo -> Bool
    is_safe_occ OccInfo
    occ Bool -> Bool -> Bool
    && Demand -> Bool
    is_safe_dmd Demand
    demand
      = Maybe IdInfo
    forall a. Maybe a
    Nothing
      | Bool
    otherwise
      = IdInfo -> Maybe IdInfo
    forall a. a -> Maybe a
    Just (IdInfo
    info {occInfo :: OccInfo
    occInfo = OccInfo
    safe_occ, demandInfo :: Demand
    demandInfo = Demand
    topDmd})
      where
            -- The "unsafe" occ info is the ones that say I'm not in a lambda
            -- because that might not be true for an unsaturated lambda
        is_safe_occ :: OccInfo -> Bool
    is_safe_occ OccInfo
    occ | OccInfo -> Bool
    isAlwaysTailCalled OccInfo
    occ           = Bool
    False
        is_safe_occ (OneOcc { occ_in_lam :: OccInfo -> InsideLam
    occ_in_lam = InsideLam
    NotInsideLam }) = Bool
    False
        is_safe_occ OccInfo
    _other                                 = Bool
    True

        safe_occ :: OccInfo
    safe_occ = case OccInfo
    occ of
                     OneOcc{} -> OccInfo
    occ { occ_in_lam :: InsideLam
    occ_in_lam = InsideLam
    IsInsideLam
                                     , occ_tail :: TailCallInfo
    occ_tail   = TailCallInfo
    NoTailCallInfo }
                     IAmALoopBreaker{}
                              -> OccInfo
    occ { occ_tail :: TailCallInfo
    occ_tail   = TailCallInfo
    NoTailCallInfo }
                     OccInfo
    _other   -> OccInfo
    occ

        is_safe_dmd :: Demand -> Bool
    is_safe_dmd Demand
    dmd = Bool -> Bool
    not (Demand -> Bool
    isStrUsedDmd Demand
    dmd)

    -- | Remove all demand info on the 'IdInfo'
    zapDemandInfo :: IdInfo -> Maybe IdInfo
    zapDemandInfo :: IdInfo -> Maybe IdInfo
    zapDemandInfo IdInfo
    info = IdInfo -> Maybe IdInfo
    forall a. a -> Maybe a
    Just (IdInfo
    info {demandInfo :: Demand
    demandInfo = Demand
    topDmd})

    -- | Remove usage (but not strictness) info on the 'IdInfo'
    zapUsageInfo :: IdInfo -> Maybe IdInfo
    zapUsageInfo :: IdInfo -> Maybe IdInfo
    zapUsageInfo IdInfo
    info = IdInfo -> Maybe IdInfo
    forall a. a -> Maybe a
    Just (IdInfo
    info {demandInfo :: Demand
    demandInfo = Demand -> Demand
    zapUsageDemand (IdInfo -> Demand
    demandInfo IdInfo
    info)})

    -- | Remove usage environment info from the strictness signature on the 'IdInfo'
    zapUsageEnvInfo :: IdInfo -> Maybe IdInfo
    zapUsageEnvInfo :: IdInfo -> Maybe IdInfo
    zapUsageEnvInfo IdInfo
    info
        | StrictSig -> Bool
    hasDemandEnvSig (IdInfo -> StrictSig
    strictnessInfo IdInfo
    info)
        = IdInfo -> Maybe IdInfo
    forall a. a -> Maybe a
    Just (IdInfo
    info {strictnessInfo :: StrictSig
    strictnessInfo = StrictSig -> StrictSig
    zapDmdEnvSig (IdInfo -> StrictSig
    strictnessInfo IdInfo
    info)})
        | Bool
    otherwise
        = Maybe IdInfo
    forall a. Maybe a
    Nothing

    zapUsedOnceInfo :: IdInfo -> Maybe IdInfo
    zapUsedOnceInfo :: IdInfo -> Maybe IdInfo
    zapUsedOnceInfo IdInfo
    info
        = IdInfo -> Maybe IdInfo
    forall a. a -> Maybe a
    Just (IdInfo -> Maybe IdInfo) -> IdInfo -> Maybe IdInfo
    forall a b. (a -> b) -> a -> b
    $ IdInfo
    info { strictnessInfo :: StrictSig
    strictnessInfo = StrictSig -> StrictSig
    zapUsedOnceSig    (IdInfo -> StrictSig
    strictnessInfo IdInfo
    info)
                      , demandInfo :: Demand
    demandInfo     = Demand -> Demand
    zapUsedOnceDemand (IdInfo -> Demand
    demandInfo     IdInfo
    info) }

    zapFragileInfo :: IdInfo -> Maybe IdInfo
    -- ^ Zap info that depends on free variables
    zapFragileInfo :: IdInfo -> Maybe IdInfo
    zapFragileInfo info :: IdInfo
    info@(IdInfo { occInfo :: IdInfo -> OccInfo
    occInfo = OccInfo
    occ, unfoldingInfo :: IdInfo -> Unfolding
    unfoldingInfo = Unfolding
    unf })
      = Unfolding
    new_unf Unfolding -> Maybe IdInfo -> Maybe IdInfo
    `seq`  -- The unfolding field is not (currently) strict, so we
                       -- force it here to avoid a (zapFragileUnfolding unf) thunk
                       -- which might leak space
        IdInfo -> Maybe IdInfo
    forall a. a -> Maybe a
    Just (IdInfo
    info IdInfo -> RuleInfo -> IdInfo
    `setRuleInfo` RuleInfo
    emptyRuleInfo
                   IdInfo -> Unfolding -> IdInfo
    `setUnfoldingInfo` Unfolding
    new_unf
                   IdInfo -> OccInfo -> IdInfo
    `setOccInfo`       OccInfo -> OccInfo
    zapFragileOcc OccInfo
    occ)
      where
        new_unf :: Unfolding
    new_unf = Unfolding -> Unfolding
    zapFragileUnfolding Unfolding
    unf

    zapFragileUnfolding :: Unfolding -> Unfolding
    zapFragileUnfolding :: Unfolding -> Unfolding
    zapFragileUnfolding Unfolding
    unf
     | Unfolding -> Bool
    hasCoreUnfolding Unfolding
    unf = Unfolding
    noUnfolding
     | Bool
    otherwise            = Unfolding
    unf

    zapUnfolding :: Unfolding -> Unfolding
    -- Squash all unfolding info, preserving only evaluated-ness
    zapUnfolding :: Unfolding -> Unfolding
    zapUnfolding Unfolding
    unf | Unfolding -> Bool
    isEvaldUnfolding Unfolding
    unf = Unfolding
    evaldUnfolding
                     | Bool
    otherwise            = Unfolding
    noUnfolding

    zapTailCallInfo :: IdInfo -> Maybe IdInfo
    zapTailCallInfo :: IdInfo -> Maybe IdInfo
    zapTailCallInfo IdInfo
    info
      = case IdInfo -> OccInfo
    occInfo IdInfo
    info of
          OccInfo
    occ | OccInfo -> Bool
    isAlwaysTailCalled OccInfo
    occ -> IdInfo -> Maybe IdInfo
    forall a. a -> Maybe a
    Just (IdInfo
    info IdInfo -> OccInfo -> IdInfo
    `setOccInfo` OccInfo
    safe_occ)
              | Bool
    otherwise              -> Maybe IdInfo
    forall a. Maybe a
    Nothing
            where
              safe_occ :: OccInfo
    safe_occ = OccInfo
    occ { occ_tail :: TailCallInfo
    occ_tail = TailCallInfo
    NoTailCallInfo }

    zapCallArityInfo :: IdInfo -> IdInfo
    zapCallArityInfo :: IdInfo -> IdInfo
    zapCallArityInfo IdInfo
    info = IdInfo -> Int -> IdInfo
    setCallArityInfo IdInfo
    info Int
    0

    {-
    ************************************************************************
    *                                                                      *
    \subsection{TickBoxOp}
    *                                                                      *
    ************************************************************************
    -}

    type TickBoxId = Int

    -- | Tick box for Hpc-style coverage
    data TickBoxOp
       = TickBox Module {-# UNPACK #-} !TickBoxId

    instance Outputable TickBoxOp where
        ppr :: TickBoxOp -> SDoc
    ppr (TickBox Module
    mod Int
    n)         = String -> SDoc
    text String
    "tick" SDoc -> SDoc -> SDoc
    <+> (Module, Int) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Module
    mod,Int
    n)

    {-
    ************************************************************************
    *                                                                      *
       Levity
    *                                                                      *
    ************************************************************************

    Note [Levity info]
    ~~~~~~~~~~~~~~~~~~

    Ids store whether or not they can be levity-polymorphic at any amount
    of saturation. This is helpful in optimizing the levity-polymorphism check
    done in the desugarer, where we can usually learn that something is not
    levity-polymorphic without actually figuring out its type. See
    isExprLevPoly in GHC.Core.Utils for where this info is used. Storing
    this is required to prevent perf/compiler/T5631 from blowing up.

    -}

    -- See Note [Levity info]
    data LevityInfo = NoLevityInfo  -- always safe
                    | NeverLevityPolymorphic
      deriving LevityInfo -> LevityInfo -> Bool
    (LevityInfo -> LevityInfo -> Bool)
    -> (LevityInfo -> LevityInfo -> Bool) -> Eq LevityInfo
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: LevityInfo -> LevityInfo -> Bool
    $c/= :: LevityInfo -> LevityInfo -> Bool
    == :: LevityInfo -> LevityInfo -> Bool
    $c== :: LevityInfo -> LevityInfo -> Bool
    Eq

    instance Outputable LevityInfo where
      ppr :: LevityInfo -> SDoc
    ppr LevityInfo
    NoLevityInfo           = String -> SDoc
    text String
    "NoLevityInfo"
      ppr LevityInfo
    NeverLevityPolymorphic = String -> SDoc
    text String
    "NeverLevityPolymorphic"

    -- | Marks an IdInfo describing an Id that is never levity polymorphic (even when
    -- applied). The Type is only there for checking that it's really never levity
    -- polymorphic
    setNeverLevPoly :: HasDebugCallStack => IdInfo -> Type -> IdInfo
    setNeverLevPoly :: HasDebugCallStack => IdInfo -> Type -> IdInfo
    setNeverLevPoly IdInfo
    info Type
    ty
      = ASSERT2( not (resultIsLevPoly ty), ppr ty )
        IdInfo
    info { bitfield :: BitField
    bitfield = LevityInfo -> BitField -> BitField
    bitfieldSetLevityInfo LevityInfo
    NeverLevityPolymorphic (IdInfo -> BitField
    bitfield IdInfo
    info) }

    setLevityInfoWithType :: IdInfo -> Type -> IdInfo
    setLevityInfoWithType :: IdInfo -> Type -> IdInfo
    setLevityInfoWithType IdInfo
    info Type
    ty
      | Bool -> Bool
    not (Type -> Bool
    resultIsLevPoly Type
    ty)
      = IdInfo
    info { bitfield :: BitField
    bitfield = LevityInfo -> BitField -> BitField
    bitfieldSetLevityInfo LevityInfo
    NeverLevityPolymorphic (IdInfo -> BitField
    bitfield IdInfo
    info) }
      | Bool
    otherwise
      = IdInfo
    info

    isNeverLevPolyIdInfo :: IdInfo -> Bool
    isNeverLevPolyIdInfo :: IdInfo -> Bool
    isNeverLevPolyIdInfo IdInfo
    info
      | LevityInfo
    NeverLevityPolymorphic <- IdInfo -> LevityInfo
    levityInfo IdInfo
    info = Bool
    True
      | Bool
    otherwise                                 = Bool
    False