    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE TupleSections    #-}
    {-# LANGUAGE MultiWayIf       #-}

    {-
    (c) The GRASP/AQUA Project, Glasgow University, 1992-2012

    Note [Unarisation]
    ~~~~~~~~~~~~~~~~~~
    The idea of this pass is to translate away *all* unboxed-tuple and unboxed-sum
    binders. So for example:

      f (x :: (# Int, Bool #)) = f x + f (# 1, True #)

      ==>

      f (x1 :: Int) (x2 :: Bool) = f x1 x2 + f 1 True

    It is important that we do this at the STG level and NOT at the Core level
    because it would be very hard to make this pass Core-type-preserving. In this
    example the type of 'f' changes, for example.

    STG fed to the code generators *must* be unarised because the code generators do
    not support unboxed tuple and unboxed sum binders natively.

    In more detail: (see next note for unboxed sums)

    Suppose that a variable x : (# t1, t2 #).

      * At the binding site for x, make up fresh vars  x1:t1, x2:t2

      * Extend the UnariseEnv   x :-> MultiVal [x1,x2]

      * Replace the binding with a curried binding for x1,x2

           Lambda:   \x.e                ==>   \x1 x2. e
           Case alt: MkT a b x c d -> e  ==>   MkT a b x1 x2 c d -> e

      * Replace argument occurrences with a sequence of args via a lookup in
        UnariseEnv

           f a b x c d   ==>   f a b x1 x2 c d

      * Replace tail-call occurrences with an unboxed tuple via a lookup in
        UnariseEnv

           x  ==>  (# x1, x2 #)

        So, for example

           f x = x    ==>   f x1 x2 = (# x1, x2 #)

      * We /always/ eliminate a case expression when

           - It scrutinises an unboxed tuple or unboxed sum

           - The scrutinee is a variable (or when it is an explicit tuple, but the
             simplifier eliminates those)

        The case alternative (there can be only one) can be one of these two
        things:

          - An unboxed tuple pattern. e.g.

              case v of x { (# x1, x2, x3 #) -> ... }

            Scrutinee has to be in form `(# t1, t2, t3 #)` so we just extend the
            environment with

              x :-> MultiVal [t1,t2,t3]
              x1 :-> UnaryVal t1, x2 :-> UnaryVal t2, x3 :-> UnaryVal t3

          - A DEFAULT alternative. Just the same, without the bindings for x1,x2,x3

    By the end of this pass, we only have unboxed tuples in return positions.
    Unboxed sums are completely eliminated, see next note.

    Note [Translating unboxed sums to unboxed tuples]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Unarise also eliminates unboxed sum binders, and translates unboxed sums in
    return positions to unboxed tuples. We want to overlap fields of a sum when
    translating it to a tuple to have efficient memory layout. When translating a
    sum pattern to a tuple pattern, we need to translate it so that binders of sum
    alternatives will be mapped to right arguments after the term translation. So
    translation of sum DataCon applications to tuple DataCon applications and
    translation of sum patterns to tuple patterns need to be in sync.

    These translations work like this. Suppose we have

      (# x1 | | ... #) :: (# t1 | t2 | ... #)

    remember that t1, t2 ... can be sums and tuples too. So we first generate
    layouts of those. Then we "merge" layouts of each alternative, which gives us a
    sum layout with best overlapping possible.

    Layout of a flat type 'ty1' is just [ty1].
    Layout of a tuple is just concatenation of layouts of its fields.

    For layout of a sum type,

      - We first get layouts of all alternatives.
      - We sort these layouts based on their "slot types".
      - We merge all the alternatives.

    For example, say we have (# (# Int#, Char #) | (# Int#, Int# #) | Int# #)

      - Layouts of alternatives: [ [Word, LiftedPtr], [Word, Word], [Word] ]
      - Sorted: [ [LiftedPtr, Word], [Word, Word], [Word] ]
      - Merge all alternatives together: [ LiftedPtr, Word, Word ]

    We add a slot for the tag to the first position. So our tuple type is

      (# Tag#, Any, Word#, Word# #)
      (we use Any for pointer slots)

    Now, any term of this sum type needs to generate a tuple of this type instead.
    The translation works by simply putting arguments to first slots that they fit
    in. Suppose we had

      (# (# 42#, 'c' #) | | #)

    42# fits in Word#, 'c' fits in Any, so we generate this application:

      (# 1#, 'c', 42#, rubbish #)

    Another example using the same type: (# | (# 2#, 3# #) | #). 2# fits in Word#,
    3# fits in Word #, so we get:

      (# 2#, rubbish, 2#, 3# #).

    Note [Don't merge lifted and unlifted slots]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When merging slots, one might be tempted to collapse lifted and unlifted
    pointers. However, as seen in #19645, this is wrong. Imagine that you have
    the program:

      test :: (# Char | ByteArray# #) -> ByteArray#
      test (# c | #) = doSomething c
      test (# | ba #) = ba

    Collapsing the Char and ByteArray# slots would produce STG like:

      test :: forall {t}. (# t | GHC.Prim.ByteArray# #) -> GHC.Prim.ByteArray#
        = {} \r [ (tag :: Int#) (slot0 :: (Any :: Type)) ]
              case tag of tag'
                1# -> doSomething slot0
                2# -> slot0;

    Note how `slot0` has a lifted type, despite being bound to an unlifted
    ByteArray# in the 2# alternative. This liftedness would cause the code generator to
    attempt to enter it upon returning. As unlifted objects do not have entry code,
    this causes a runtime crash.

    For this reason, Unarise treats unlifted and lifted things as distinct slot
    types, despite both being GC pointers. This approach is a slight pessimisation
    (since we need to pass more arguments) but appears to be the simplest way to
    avoid #19645. Other alternatives considered include:

     a. Giving unlifted objects "trivial" entry code. However, we ultimately
        concluded that the value of the "unlifted things are never entered" invariant
        outweighed the simplicity of this approach.

     b. Annotating occurrences with calling convention information instead of
        relying on the binder's type. This seemed like a very complicated
        way to fix what is ultimately a corner-case.

    Note [Representations in StgConApp]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Suppose we have this unboxed sum term:

      (# 123 | #)

    What will be the unboxed tuple representation? We can't tell without knowing the
    type of this term. For example, these are all valid tuples for this:

      (# 1#, 123 #)          -- when type is (# Int | String #)
      (# 1#, 123, rubbish #) -- when type is (# Int | Float# #)
      (# 1#, 123, rubbish, rubbish #)
                             -- when type is (# Int | (# Int, Int, Int #) #)

    Therefore, in StgConApp we store a list [[PrimRep]] of representations
    to decide what layout to use.
    Given (# T_1 | ... | T_n #), this list will be
    [typePrimRep T_1, ..., typePrimRep T_n].
    For example, given type
      (# Int | String #)              we will store [[LiftedRep], [LiftedRep]]
      (# Int | Float# #)              we will store [[LiftedRep], [FloatRep]]
      (# Int | (# Int, Int, Int #) #) we will store [[LiftedRep], [LiftedRep, LiftedRep, LiftedRep]].

    This field is used for unboxed sums only and it's an empty list otherwise.
    Perhaps it would be more elegant to have a separate StgUnboxedSumCon,
    but that would require duplication of code in cases where the logic is shared.

    Note that unlifted values can't be let-bound, so we don't need
    representations in StgRhsCon.

    Note [Casting slot arguments]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider this function which selects between Int32# and Int64# from a unboxed sum.

        foo ::  (# Int32# | Int64#  #) -> FD
        foo x = case x of
            (# x1 | #) -> F x1
            (# | x2 #) -> D x2

    Naturally we would expect x1 to have a PrimRep of Int32Rep and x2 of DoubleRep.
    However we used to generate this (bogus) code after Unarise giving rise to #22208:

        M.foo :: (# GHC.Prim.Int32# | GHC.Prim.Int64# #) -> M.FD
        [GblId, Arity=1, Unf=OtherCon []] =
            {} \r [sum_tag sum_field]
                case sum_tag of tag_gsc {
                  __DEFAULT -> M.F [sum_field];
                  2# -> M.D [sum_field];
                };

    Where sum_field is used both as Int32# and Int64# depending on the branch
    because they share the same SlotTy.
    This usually works out since we put all int's in the same sort of register.
    So even if the reps where wrong (x :: bits32) = (y :: bits64) would produce
    correct code in the most cases.
    However there are cases where this goes wrong, causing lint errors,in the case of #22208
    compiler panics or in some cases incorrect results in the C backend.
    For now our solution is to construct proper casts between the PrimRep of the slot and
    the variables we want to store in, or read out of these slots.

    This means when we have a sum (# Int32# | Int64# #) if we want to store a Int32
    we convert it to a Int64 on construction of the tuple value, and convert it back
    to a Int32 once when want to use the field. On most backends these coversions should
    be no-ops at runtime so this seems reasonable.

    Conversion for values coming out of a strict field happen in mapSumIdBinders. While
    conversion during the construction of sums happen inside mkUbxSum.

    ------------- A full example of casting during sum construction ----------------

    To compile a constructor application of a unboxed sum of type (# Int32# | Int64# )
    in an expression like  `let sum = (# x | #)` we will call mkUbxSum to determine
    which binders we have to replace sum with at use sites during unarise.
    See also Note [Translating unboxed sums to unboxed tuples].

    Int32# and Int64# in this case will share the same slot in the unboxed sum. This means
    the sum after unarise will be represented by two binders. One for the tag and one for
    the field. The later having Int64Rep.
    However our input for the field is of Int32Rep. So in order to soundly construct
    `(# x | #) :: (# Int32# | Int64# )` we must upcast `x` to Int64#.
    To do this mkUbxSum will produce an expression with a hole for constructor application
    to go into. That is the call to mkUbxSum and it's result will look something like:

      >>> mkUbxSum (#|#) [Int32#, Int64#] (x::Int32#) us (x')
      ([1#::Int#, x'::Int64#], \rhs -> case int32ToInt# x of x' -> rhs )

    We will use the returned arguments to construct an application to an unboxed tuple:

      >>> mkTuple [tag::Int#, x'::Int64#]
      (# tag, x' #)

    Which we will then use as the rhs to pass into the casting wrapper to
    construct an expression that casts `x` to the right type before constructing the
    tuple

      >>> (\rhs -> case int32ToInt# x of x' -> rhs ) (# tag, x' #)
      case int32ToInt# x of x' -> (# #) 1# x'

    Which results in the this definition for `sum` after all is said and done:

      let sum = case int32ToInt# x of { x' -> (# #) 1# x' }

    Not that the renaming is not optional. Cmm requires binders of different uniques
    to have at least different types. See Note [CorePrep Overview]: 6. Clone all local Ids

    ------------- A full example of casting during sum matching --------------------

    When matching on an unboxed sum constructor we start out with
    something like this the pre-unarise:

        f :: (# Int32 | Int64# ) -> ...
        f sum = case sum of
            (# x |#) -> alt_rhs
            ...

    We unarise the function arguments and get:

        f sum_tag sum_slot1 = case sum_tag of
            1# -> ???

    Now we need to match up the original alternative binders with the sum slots passed
    to the function. This is done by mapSumIdBinders which we we call for our
    example alternative like this:

        >>> mapSumIdBinders [x] [sum_slot1] alt_rhs env
        (env', alt_rhs')

    mapSumIdBinders first matches up the list of binders with the slots passed to
    the function which is trivial in this case. Then we check if the slot and the
    variable residing inside it agree on their Rep. If alternative binders and
    the function arguments agree in their slot reps we we just extend the environment
    with a mapping from `x` to `sum_slot1` and we return the rhs as is.

    If the reps of the sum_slots do not agree with alternative binders they represent
    then we need to wrap the whole RHS in nested cases which cast the sum_slot<n>
    variables to the correct rep. Here `x` is of Int32Rep while `sum_slot1` will be
    of Int64Rep. This means instead of retuning the original alt_rhs we will return:

      >>> mapSumIdBinders [x] [sum_slot1] alt_rhs env
      ( env'[x=x']
      , case int64ToInt32# (sum_slot1 :: Int64#) of
          (x' :: Int32#) -> alt_rhs
      )

    We then run unarise on alt_rhs within that expression, which will replace the first occurrence
    of `x` with sum_slot_arg_1 giving us post-unarise:

        f sum_tag sum_slot1 =
          case sum_tag of
            1# -> case int64ToInt32# sum_slot1 of
              x' -> ... x' ...
            ...

    Note [UnariseEnv]
    ~~~~~~~~~~~~~~~~~~
    At any variable occurrence 'v',
    * If the UnariseEnv has a binding for 'v', the binding says what 'v' is bound to
    * If not, 'v' stands just for itself.

    Most variables are unaffected by unarisation, and (for efficiency) we don't put
    them in the UnariseEnv at all.  But NB: when we go under a binding for 'v' we must
    remember to delete 'v' from the UnariseEnv, lest occurrences of 'v' see the outer
    binding for the variable (#21396).

    Note [UnariseEnv can map to literals]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    To avoid redundant case expressions when unarising unboxed sums, UnariseEnv
    needs to map variables to literals too. Suppose we have this Core:

      f (# x | #)

      ==> (CorePrep)

      case (# x | #) of y {
        _ -> f y
      }

      ==> (MultiVal)

      case (# 1#, x #) of [x1, x2] {
        _ -> f x1 x2
      }

    To eliminate this case expression we need to map x1 to 1# in UnariseEnv:

      x1 :-> UnaryVal 1#, x2 :-> UnaryVal x

    so that `f x1 x2` becomes `f 1# x`.

    Note [Unarisation and arity]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Because of unarisation, the arity that will be recorded in the generated info
    table for an Id may be larger than the idArity. Instead we record what we call
    the RepArity, which is the Arity taking into account any expanded arguments, and
    corresponds to the number of (possibly-void) *registers* arguments will arrive
    in.

    Note [Post-unarisation invariants]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    STG programs after unarisation have these invariants:

     1. No unboxed sums at all.

     2. No unboxed tuple binders. Tuples only appear in return position.

     3. Binders and literals always have zero (for void arguments) or one PrimRep.
        (i.e. typePrimRep1 won't crash; see Note [VoidRep] in GHC.Types.RepType.)

     4. DataCon applications (StgRhsCon and StgConApp) don't have void arguments.
        This means that it's safe to wrap `StgArg`s of DataCon applications with
        `GHC.StgToCmm.Env.NonVoid`, for example.

     5. Alt binders (binders in patterns) are always non-void.
    -}

    module GHC.Stg.Unarise (unarise) where

    import GHC.Prelude

    import GHC.Types.Basic
    import GHC.Core
    import GHC.Core.DataCon
    import GHC.Core.TyCon
    import GHC.Data.FastString (FastString, mkFastString, fsLit)
    import GHC.Types.Id
    import GHC.Types.Literal
    import GHC.Core.Make (aBSENT_SUM_FIELD_ERROR_ID)
    import GHC.Types.Id.Make (voidPrimId, voidArgId)
    import GHC.Utils.Monad (mapAccumLM)
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Types.RepType
    import GHC.Stg.Syntax
    import GHC.Stg.Utils
    import GHC.Stg.Make
    import GHC.Core.Type
    import GHC.Builtin.Types.Prim (intPrimTy)
    import GHC.Builtin.Types
    import GHC.Types.Unique.Supply
    import GHC.Types.Unique
    import GHC.Utils.Misc
    import GHC.Types.Var.Env

    import Data.Bifunctor (second)
    import Data.List.NonEmpty (NonEmpty (..))
    import Data.Maybe (mapMaybe)
    import qualified Data.IntMap as IM
    import GHC.Builtin.PrimOps
    import GHC.Builtin.PrimOps.Casts
    import Data.List (mapAccumL)

    -- import GHC.Utils.Trace
    --------------------------------------------------------------------------------

    -- | A mapping from binders to the Ids they were expanded/renamed to.
    --
    --   x :-> MultiVal [a,b,c] in rho
    --
    -- iff  x's typePrimRep is not a singleton, or equivalently
    --      x's type is an unboxed tuple, sum or void.
    --
    --    x :-> UnaryVal x'
    --
    -- iff x's RepType is UnaryRep or equivalently
    --     x's type is not unboxed tuple, sum or void.
    --
    -- So
    --     x :-> MultiVal [a] in rho
    -- means x is represented by singleton tuple.
    --
    --     x :-> MultiVal [] in rho
    -- means x is void.
    --
    -- INVARIANT: OutStgArgs in the range only have NvUnaryTypes
    --            (i.e. no unboxed tuples, sums or voids)
    --
    data UnariseEnv = UnariseEnv
      { UnariseEnv -> VarEnv UnariseVal
    ue_rho                 :: (VarEnv UnariseVal)
      , UnariseEnv -> DataCon -> [StgArg] -> Bool
    ue_allow_static_conapp :: DataCon -> [StgArg] -> Bool
      }

    initUnariseEnv :: VarEnv UnariseVal -> (DataCon -> [StgArg] -> Bool) -> UnariseEnv
    initUnariseEnv :: VarEnv UnariseVal -> (DataCon -> [StgArg] -> Bool) -> UnariseEnv
    initUnariseEnv = VarEnv UnariseVal -> (DataCon -> [StgArg] -> Bool) -> UnariseEnv
    UnariseEnv

    data UnariseVal
      = MultiVal [OutStgArg] -- MultiVal to tuple. Can be empty list (void).
      | UnaryVal OutStgArg   -- See Note [Renaming during unarisation].

    instance Outputable UnariseVal where
      ppr :: UnariseVal -> SDoc
    ppr (MultiVal [StgArg]
    args) = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "MultiVal" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [StgArg] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [StgArg]
    args
      ppr (UnaryVal StgArg
    arg)   = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "UnaryVal" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> StgArg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr StgArg
    arg

    -- | Extend the environment, checking the UnariseEnv invariant.
    -- The id is mapped to one or more things.
    -- See Note [UnariseEnv]
    extendRho :: UnariseEnv -> Id -> UnariseVal -> UnariseEnv
    extendRho :: UnariseEnv -> Id -> UnariseVal -> UnariseEnv
    extendRho UnariseEnv
    env Id
    x (MultiVal [StgArg]
    args)
      = Bool -> UnariseEnv -> UnariseEnv
    forall a. HasCallStack => Bool -> a -> a
    assert ((StgArg -> Bool) -> [StgArg] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ([PrimRep] -> Bool
    isNvUnaryRep ([PrimRep] -> Bool) -> (StgArg -> [PrimRep]) -> StgArg -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StgArg -> [PrimRep]
    stgArgRep) [StgArg]
    args)
        UnariseEnv
    env { ue_rho = extendVarEnv (ue_rho env) x (MultiVal args) }
    extendRho UnariseEnv
    env Id
    x (UnaryVal StgArg
    val)
      = Bool -> UnariseEnv -> UnariseEnv
    forall a. HasCallStack => Bool -> a -> a
    assert ([PrimRep] -> Bool
    isNvUnaryRep (StgArg -> [PrimRep]
    stgArgRep StgArg
    val))
        UnariseEnv
    env { ue_rho = extendVarEnv (ue_rho env) x (UnaryVal val) }
    -- Properly shadow things from an outer scope.
    -- See Note [UnariseEnv]

    -- The id stands for itself so we don't record a mapping.
    -- See Note [UnariseEnv]
    extendRhoWithoutValue :: UnariseEnv -> Id -> UnariseEnv
    extendRhoWithoutValue :: UnariseEnv -> Id -> UnariseEnv
    extendRhoWithoutValue UnariseEnv
    env Id
    x = UnariseEnv
    env { ue_rho = delVarEnv (ue_rho env) x }

    lookupRho :: UnariseEnv -> Id -> Maybe UnariseVal
    lookupRho :: UnariseEnv -> Id -> Maybe UnariseVal
    lookupRho UnariseEnv
    env Id
    v = VarEnv UnariseVal -> Id -> Maybe UnariseVal
    forall a. VarEnv a -> Id -> Maybe a
    lookupVarEnv (UnariseEnv -> VarEnv UnariseVal
    ue_rho UnariseEnv
    env) Id
    v

    --------------------------------------------------------------------------------

    unarise :: UniqSupply -> (DataCon -> [StgArg] -> Bool) -> [StgTopBinding] -> [StgTopBinding]
    unarise :: UniqSupply
    -> (DataCon -> [StgArg] -> Bool)
    -> [StgTopBinding]
    -> [StgTopBinding]
    unarise UniqSupply
    us DataCon -> [StgArg] -> Bool
    is_dll_con_app [StgTopBinding]
    binds = UniqSupply -> UniqSM [StgTopBinding] -> [StgTopBinding]
    forall a. UniqSupply -> UniqSM a -> a
    initUs_ UniqSupply
    us ((StgTopBinding -> UniqSM StgTopBinding)
    -> [StgTopBinding] -> UniqSM [StgTopBinding]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (UnariseEnv -> StgTopBinding -> UniqSM StgTopBinding
    unariseTopBinding (VarEnv UnariseVal -> (DataCon -> [StgArg] -> Bool) -> UnariseEnv
    initUnariseEnv VarEnv UnariseVal
    forall a. VarEnv a
    emptyVarEnv DataCon -> [StgArg] -> Bool
    is_dll_con_app)) [StgTopBinding]
    binds)

    unariseTopBinding :: UnariseEnv -> StgTopBinding -> UniqSM StgTopBinding
    unariseTopBinding :: UnariseEnv -> StgTopBinding -> UniqSM StgTopBinding
    unariseTopBinding UnariseEnv
    rho (StgTopLifted GenStgBinding 'Vanilla
    bind)
      = GenStgBinding 'Vanilla -> StgTopBinding
    forall (pass :: StgPass).
    GenStgBinding pass -> GenStgTopBinding pass
    StgTopLifted (GenStgBinding 'Vanilla -> StgTopBinding)
    -> UniqSM (GenStgBinding 'Vanilla) -> UniqSM StgTopBinding
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> UnariseEnv
    -> Bool
    -> GenStgBinding 'Vanilla
    -> UniqSM (GenStgBinding 'Vanilla)
    unariseBinding UnariseEnv
    rho Bool
    True GenStgBinding 'Vanilla
    bind
    unariseTopBinding UnariseEnv
    _ bind :: StgTopBinding
    bind@StgTopStringLit{} = StgTopBinding -> UniqSM StgTopBinding
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return StgTopBinding
    bind

    unariseBinding :: UnariseEnv -> Bool -> StgBinding -> UniqSM StgBinding
    unariseBinding :: UnariseEnv
    -> Bool
    -> GenStgBinding 'Vanilla
    -> UniqSM (GenStgBinding 'Vanilla)
    unariseBinding UnariseEnv
    rho Bool
    top_level (StgNonRec BinderP 'Vanilla
    x GenStgRhs 'Vanilla
    rhs)
      = BinderP 'Vanilla -> GenStgRhs 'Vanilla -> GenStgBinding 'Vanilla
    forall (pass :: StgPass).
    BinderP pass -> GenStgRhs pass -> GenStgBinding pass
    StgNonRec BinderP 'Vanilla
    x (GenStgRhs 'Vanilla -> GenStgBinding 'Vanilla)
    -> UniqSM (GenStgRhs 'Vanilla) -> UniqSM (GenStgBinding 'Vanilla)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> UnariseEnv
    -> Bool -> GenStgRhs 'Vanilla -> UniqSM (GenStgRhs 'Vanilla)
    unariseRhs UnariseEnv
    rho Bool
    top_level GenStgRhs 'Vanilla
    rhs
    unariseBinding UnariseEnv
    rho Bool
    top_level (StgRec [(BinderP 'Vanilla, GenStgRhs 'Vanilla)]
    xrhss)
      = [(Id, GenStgRhs 'Vanilla)] -> GenStgBinding 'Vanilla
    [(BinderP 'Vanilla, GenStgRhs 'Vanilla)] -> GenStgBinding 'Vanilla
    forall (pass :: StgPass).
    [(BinderP pass, GenStgRhs pass)] -> GenStgBinding pass
    StgRec ([(Id, GenStgRhs 'Vanilla)] -> GenStgBinding 'Vanilla)
    -> UniqSM [(Id, GenStgRhs 'Vanilla)]
    -> UniqSM (GenStgBinding 'Vanilla)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((Id, GenStgRhs 'Vanilla) -> UniqSM (Id, GenStgRhs 'Vanilla))
    -> [(Id, GenStgRhs 'Vanilla)] -> UniqSM [(Id, GenStgRhs 'Vanilla)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (\(Id
    x, GenStgRhs 'Vanilla
    rhs) -> (Id
    x,) (GenStgRhs 'Vanilla -> (Id, GenStgRhs 'Vanilla))
    -> UniqSM (GenStgRhs 'Vanilla) -> UniqSM (Id, GenStgRhs 'Vanilla)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> UnariseEnv
    -> Bool -> GenStgRhs 'Vanilla -> UniqSM (GenStgRhs 'Vanilla)
    unariseRhs UnariseEnv
    rho Bool
    top_level GenStgRhs 'Vanilla
    rhs) [(Id, GenStgRhs 'Vanilla)]
    [(BinderP 'Vanilla, GenStgRhs 'Vanilla)]
    xrhss

    unariseRhs :: UnariseEnv -> Bool -> StgRhs -> UniqSM StgRhs
    unariseRhs :: UnariseEnv
    -> Bool -> GenStgRhs 'Vanilla -> UniqSM (GenStgRhs 'Vanilla)
    unariseRhs UnariseEnv
    rho Bool
    top_level (StgRhsClosure XRhsClosure 'Vanilla
    ext CostCentreStack
    ccs UpdateFlag
    update_flag [BinderP 'Vanilla]
    args GenStgExpr 'Vanilla
    expr Type
    typ)
      = do (rho', args1) <- UnariseEnv -> [Id] -> UniqSM (UnariseEnv, [Id])
    unariseFunArgBinders UnariseEnv
    rho [Id]
    [BinderP 'Vanilla]
    args
           expr' <- unariseExpr rho' expr
           -- Unarisation can lead to a StgRhsClosure becoming a StgRhsCon.
           -- Hence, we call `mk(Top)StgRhsCon_maybe` rather than just building
           -- another `StgRhsClosure`.
           --
           -- For example with unboxed sums (#25166):
           --
           --     foo = \u [] case (# | _ | #) [(##)] of tag { __DEFAULT -> D [True tag] }
           --
           --  ====> {unarisation}
           --
           --     foo = D [True 2#]
           --
           -- Transforming an appropriate StgRhsClosure into a StgRhsCon is
           -- important as top-level StgRhsCon are statically allocated.
           --
           let mk_rhs = MkStgRhs
                { rhs_args :: [Id]
    rhs_args = [Id]
    args1
                , rhs_expr :: GenStgExpr 'Vanilla
    rhs_expr = GenStgExpr 'Vanilla
    expr'
                , rhs_type :: Type
    rhs_type = Type
    typ
                , rhs_is_join :: Bool
    rhs_is_join = UpdateFlag
    update_flag UpdateFlag -> UpdateFlag -> Bool
    forall a. Eq a => a -> a -> Bool
    == UpdateFlag
    JumpedTo
                }
           if | top_level
              , Just rhs_con <- mkTopStgRhsCon_maybe (ue_allow_static_conapp rho) mk_rhs
              -> pure rhs_con

              | not top_level
              , Just rhs_con <- mkStgRhsCon_maybe mk_rhs
              -> pure rhs_con

              | otherwise
              -> pure (StgRhsClosure ext ccs update_flag args1 expr' typ)

    unariseRhs UnariseEnv
    rho Bool
    _top (StgRhsCon CostCentreStack
    ccs DataCon
    con ConstructorNumber
    mu [StgTickish]
    ts [StgArg]
    args Type
    typ)
      = Bool
    -> (GenStgRhs 'Vanilla -> UniqSM (GenStgRhs 'Vanilla))
    -> GenStgRhs 'Vanilla
    -> UniqSM (GenStgRhs 'Vanilla)
    forall a. HasCallStack => Bool -> a -> a
    assert (Bool -> Bool
    not (DataCon -> Bool
    isUnboxedTupleDataCon DataCon
    con Bool -> Bool -> Bool
    || DataCon -> Bool
    isUnboxedSumDataCon DataCon
    con))
        GenStgRhs 'Vanilla -> UniqSM (GenStgRhs 'Vanilla)
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CostCentreStack
    -> DataCon
    -> ConstructorNumber
    -> [StgTickish]
    -> [StgArg]
    -> Type
    -> GenStgRhs 'Vanilla
    forall (pass :: StgPass).
    CostCentreStack
    -> DataCon
    -> ConstructorNumber
    -> [StgTickish]
    -> [StgArg]
    -> Type
    -> GenStgRhs pass
    StgRhsCon CostCentreStack
    ccs DataCon
    con ConstructorNumber
    mu [StgTickish]
    ts (UnariseEnv -> [StgArg] -> [StgArg]
    unariseConArgs UnariseEnv
    rho [StgArg]
    args) Type
    typ)

    --------------------------------------------------------------------------------

    unariseExpr :: UnariseEnv -> StgExpr -> UniqSM StgExpr

    unariseExpr :: UnariseEnv -> GenStgExpr 'Vanilla -> UniqSM (GenStgExpr 'Vanilla)
    unariseExpr UnariseEnv
    rho e :: GenStgExpr 'Vanilla
    e@(StgApp Id
    f [])
      = case UnariseEnv -> Id -> Maybe UnariseVal
    lookupRho UnariseEnv
    rho Id
    f of
          Just (MultiVal [StgArg]
    args)  -- Including empty tuples
            -> GenStgExpr 'Vanilla -> UniqSM (GenStgExpr 'Vanilla)
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([StgArg] -> GenStgExpr 'Vanilla
    mkTuple [StgArg]
    args)
          Just (UnaryVal (StgVarArg Id
    f'))
            -> GenStgExpr 'Vanilla -> UniqSM (GenStgExpr 'Vanilla)
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Id -> [StgArg] -> GenStgExpr 'Vanilla
    forall (pass :: StgPass). Id -> [StgArg] -> GenStgExpr pass
    StgApp Id
    f' [])
          Just (UnaryVal (StgLitArg Literal
    f'))
            -> GenStgExpr 'Vanilla -> UniqSM (GenStgExpr 'Vanilla)
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Literal -> GenStgExpr 'Vanilla
    forall (pass :: StgPass). Literal -> GenStgExpr pass
    StgLit Literal
    f')
          Maybe UnariseVal
    Nothing
            -> GenStgExpr 'Vanilla -> UniqSM (GenStgExpr 'Vanilla)
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return GenStgExpr 'Vanilla
    e

    unariseExpr UnariseEnv
    rho e :: GenStgExpr 'Vanilla
    e@(StgApp Id
    f [StgArg]
    args)
      = GenStgExpr 'Vanilla -> UniqSM (GenStgExpr 'Vanilla)
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Id -> [StgArg] -> GenStgExpr 'Vanilla
    forall (pass :: StgPass). Id -> [StgArg] -> GenStgExpr pass
    StgApp Id
    f' (UnariseEnv -> [StgArg] -> [StgArg]
    unariseFunArgs UnariseEnv
    rho [StgArg]
    args))
      where
        f' :: Id
    f' = case UnariseEnv -> Id -> Maybe UnariseVal
    lookupRho UnariseEnv
    rho Id
    f of
               Just (UnaryVal (StgVarArg Id
    f')) -> Id
    f'
               Maybe UnariseVal
    Nothing -> Id
    f
               Maybe UnariseVal
    err -> String -> SDoc -> Id
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "unariseExpr - app2" (StgPprOpts -> GenStgExpr 'Vanilla -> SDoc
    forall (pass :: StgPass).
    OutputablePass pass =>
    StgPprOpts -> GenStgExpr pass -> SDoc
    pprStgExpr StgPprOpts
    panicStgPprOpts GenStgExpr 'Vanilla
    e SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ Maybe UnariseVal -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Maybe UnariseVal
    err)
                   -- Can't happen because 'args' is non-empty, and
                   -- a tuple or sum cannot be applied to anything

    unariseExpr UnariseEnv
    _ (StgLit Literal
    l)
      = GenStgExpr 'Vanilla -> UniqSM (GenStgExpr 'Vanilla)
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Literal -> GenStgExpr 'Vanilla
    forall (pass :: StgPass). Literal -> GenStgExpr pass
    StgLit Literal
    l)

    unariseExpr UnariseEnv
    rho (StgConApp DataCon
    dc ConstructorNumber
    n [StgArg]
    args [[PrimRep]]
    ty_args)
      | DataCon -> Bool
    isUnboxedSumDataCon DataCon
    dc Bool -> Bool -> Bool
    || DataCon -> Bool
    isUnboxedTupleDataCon DataCon
    dc
      = do
          us <- UniqSM UniqSupply
    forall (m :: * -> *). MonadUnique m => m UniqSupply
    getUniqueSupplyM
          case unariseUbxSumOrTupleArgs rho us dc args ty_args of
            ([StgArg]
    args', Just GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla
    cast_wrapper)
              -> GenStgExpr 'Vanilla -> UniqSM (GenStgExpr 'Vanilla)
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GenStgExpr 'Vanilla -> UniqSM (GenStgExpr 'Vanilla))
    -> GenStgExpr 'Vanilla -> UniqSM (GenStgExpr 'Vanilla)
    forall a b. (a -> b) -> a -> b
    $ GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla
    cast_wrapper ([StgArg] -> GenStgExpr 'Vanilla
    mkTuple [StgArg]
    args')
            ([StgArg]
    args', Maybe (GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    Nothing)
              -> GenStgExpr 'Vanilla -> UniqSM (GenStgExpr 'Vanilla)
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GenStgExpr 'Vanilla -> UniqSM (GenStgExpr 'Vanilla))
    -> GenStgExpr 'Vanilla -> UniqSM (GenStgExpr 'Vanilla)
    forall a b. (a -> b) -> a -> b
    $ ([StgArg] -> GenStgExpr 'Vanilla
    mkTuple [StgArg]
    args')
      | Bool
    otherwise =
          let args' :: [StgArg]
    args' = UnariseEnv -> [StgArg] -> [StgArg]
    unariseConArgs UnariseEnv
    rho [StgArg]
    args in
          GenStgExpr 'Vanilla -> UniqSM (GenStgExpr 'Vanilla)
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GenStgExpr 'Vanilla -> UniqSM (GenStgExpr 'Vanilla))
    -> GenStgExpr 'Vanilla -> UniqSM (GenStgExpr 'Vanilla)
    forall a b. (a -> b) -> a -> b
    $ (DataCon
    -> ConstructorNumber
    -> [StgArg]
    -> [[PrimRep]]
    -> GenStgExpr 'Vanilla
    forall (pass :: StgPass).
    DataCon
    -> ConstructorNumber -> [StgArg] -> [[PrimRep]] -> GenStgExpr pass
    StgConApp DataCon
    dc ConstructorNumber
    n [StgArg]
    args' [])

    unariseExpr UnariseEnv
    rho (StgOpApp StgOp
    op [StgArg]
    args Type
    ty)
      = GenStgExpr 'Vanilla -> UniqSM (GenStgExpr 'Vanilla)
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (StgOp -> [StgArg] -> Type -> GenStgExpr 'Vanilla
    forall (pass :: StgPass).
    StgOp -> [StgArg] -> Type -> GenStgExpr pass
    StgOpApp StgOp
    op (UnariseEnv -> [StgArg] -> [StgArg]
    unariseFunArgs UnariseEnv
    rho [StgArg]
    args) Type
    ty)

    unariseExpr UnariseEnv
    rho (StgCase GenStgExpr 'Vanilla
    scrut BinderP 'Vanilla
    bndr AltType
    alt_ty [GenStgAlt 'Vanilla]
    alts)
      -- tuple/sum binders in the scrutinee can always be eliminated
      | StgApp Id
    v [] <- GenStgExpr 'Vanilla
    scrut
      , Just (MultiVal [StgArg]
    xs) <- UnariseEnv -> Id -> Maybe UnariseVal
    lookupRho UnariseEnv
    rho Id
    v
      = UnariseEnv
    -> [StgArg]
    -> Id
    -> AltType
    -> [GenStgAlt 'Vanilla]
    -> UniqSM (GenStgExpr 'Vanilla)
    elimCase UnariseEnv
    rho [StgArg]
    xs Id
    BinderP 'Vanilla
    bndr AltType
    alt_ty [GenStgAlt 'Vanilla]
    alts

      -- Handle strict lets for tuples and sums:
      --   case (# a,b #) of r -> rhs
      -- and analogously for sums
      | StgConApp DataCon
    dc ConstructorNumber
    _n [StgArg]
    args [[PrimRep]]
    ty_args <- GenStgExpr 'Vanilla
    scrut
      , DataCon -> Bool
    isUnboxedSumDataCon DataCon
    dc Bool -> Bool -> Bool
    || DataCon -> Bool
    isUnboxedTupleDataCon DataCon
    dc
      = do
        us <- UniqSM UniqSupply
    forall (m :: * -> *). MonadUnique m => m UniqSupply
    getUniqueSupplyM
        case unariseUbxSumOrTupleArgs rho us dc args ty_args of
          ([StgArg]
    args',Just GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla
    wrapper) -> GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla
    wrapper (GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    -> UniqSM (GenStgExpr 'Vanilla) -> UniqSM (GenStgExpr 'Vanilla)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> UnariseEnv
    -> [StgArg]
    -> Id
    -> AltType
    -> [GenStgAlt 'Vanilla]
    -> UniqSM (GenStgExpr 'Vanilla)
    elimCase UnariseEnv
    rho [StgArg]
    args' Id
    BinderP 'Vanilla
    bndr AltType
    alt_ty [GenStgAlt 'Vanilla]
    alts
          ([StgArg]
    args',Maybe (GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    Nothing) -> UnariseEnv
    -> [StgArg]
    -> Id
    -> AltType
    -> [GenStgAlt 'Vanilla]
    -> UniqSM (GenStgExpr 'Vanilla)
    elimCase UnariseEnv
    rho [StgArg]
    args' Id
    BinderP 'Vanilla
    bndr AltType
    alt_ty [GenStgAlt 'Vanilla]
    alts

      -- See (3) of Note [Rubbish literals] in GHC.Types.Literal
      | StgLit Literal
    lit <- GenStgExpr 'Vanilla
    scrut
      , Just [StgArg]
    args' <- Literal -> Maybe [StgArg]
    unariseLiteral_maybe Literal
    lit
      = UnariseEnv
    -> [StgArg]
    -> Id
    -> AltType
    -> [GenStgAlt 'Vanilla]
    -> UniqSM (GenStgExpr 'Vanilla)
    elimCase UnariseEnv
    rho [StgArg]
    args' Id
    BinderP 'Vanilla
    bndr AltType
    alt_ty [GenStgAlt 'Vanilla]
    alts

      -- general case
      | Bool
    otherwise
      = do scrut' <- UnariseEnv -> GenStgExpr 'Vanilla -> UniqSM (GenStgExpr 'Vanilla)
    unariseExpr UnariseEnv
    rho GenStgExpr 'Vanilla
    scrut
           alts'  <- unariseAlts rho alt_ty bndr alts
           return (StgCase scrut' bndr alt_ty alts')
                           -- bndr may have a unboxed sum/tuple type but it will be
                           -- dead after unarise (checked in GHC.Stg.Lint)

    unariseExpr UnariseEnv
    rho (StgLet XLet 'Vanilla
    ext GenStgBinding 'Vanilla
    bind GenStgExpr 'Vanilla
    e)
      = XLet 'Vanilla
    -> GenStgBinding 'Vanilla
    -> GenStgExpr 'Vanilla
    -> GenStgExpr 'Vanilla
    forall (pass :: StgPass).
    XLet pass
    -> GenStgBinding pass -> GenStgExpr pass -> GenStgExpr pass
    StgLet XLet 'Vanilla
    ext (GenStgBinding 'Vanilla
     -> GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    -> UniqSM (GenStgBinding 'Vanilla)
    -> UniqSM (GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> UnariseEnv
    -> Bool
    -> GenStgBinding 'Vanilla
    -> UniqSM (GenStgBinding 'Vanilla)
    unariseBinding UnariseEnv
    rho Bool
    False GenStgBinding 'Vanilla
    bind UniqSM (GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    -> UniqSM (GenStgExpr 'Vanilla) -> UniqSM (GenStgExpr 'Vanilla)
    forall a b. UniqSM (a -> b) -> UniqSM a -> UniqSM b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> UnariseEnv -> GenStgExpr 'Vanilla -> UniqSM (GenStgExpr 'Vanilla)
    unariseExpr UnariseEnv
    rho GenStgExpr 'Vanilla
    e

    unariseExpr UnariseEnv
    rho (StgLetNoEscape XLetNoEscape 'Vanilla
    ext GenStgBinding 'Vanilla
    bind GenStgExpr 'Vanilla
    e)
      = XLetNoEscape 'Vanilla
    -> GenStgBinding 'Vanilla
    -> GenStgExpr 'Vanilla
    -> GenStgExpr 'Vanilla
    forall (pass :: StgPass).
    XLetNoEscape pass
    -> GenStgBinding pass -> GenStgExpr pass -> GenStgExpr pass
    StgLetNoEscape XLetNoEscape 'Vanilla
    ext (GenStgBinding 'Vanilla
     -> GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    -> UniqSM (GenStgBinding 'Vanilla)
    -> UniqSM (GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> UnariseEnv
    -> Bool
    -> GenStgBinding 'Vanilla
    -> UniqSM (GenStgBinding 'Vanilla)
    unariseBinding UnariseEnv
    rho Bool
    False GenStgBinding 'Vanilla
    bind UniqSM (GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    -> UniqSM (GenStgExpr 'Vanilla) -> UniqSM (GenStgExpr 'Vanilla)
    forall a b. UniqSM (a -> b) -> UniqSM a -> UniqSM b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> UnariseEnv -> GenStgExpr 'Vanilla -> UniqSM (GenStgExpr 'Vanilla)
    unariseExpr UnariseEnv
    rho GenStgExpr 'Vanilla
    e

    unariseExpr UnariseEnv
    rho (StgTick StgTickish
    tick GenStgExpr 'Vanilla
    e)
      = StgTickish -> GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla
    forall (pass :: StgPass).
    StgTickish -> GenStgExpr pass -> GenStgExpr pass
    StgTick StgTickish
    tick (GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    -> UniqSM (GenStgExpr 'Vanilla) -> UniqSM (GenStgExpr 'Vanilla)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> UnariseEnv -> GenStgExpr 'Vanilla -> UniqSM (GenStgExpr 'Vanilla)
    unariseExpr UnariseEnv
    rho GenStgExpr 'Vanilla
    e

    -- Doesn't return void args.
    unariseUbxSumOrTupleArgs :: UnariseEnv -> UniqSupply -> DataCon -> [InStgArg] -> [[PrimRep]]
                       -> ( [OutStgArg]           -- Arguments representing the unboxed sum
                          , Maybe (StgExpr -> StgExpr)) -- Transformation to apply to the arguments, to bring them
                                                        -- into the right Rep
    unariseUbxSumOrTupleArgs :: UnariseEnv
    -> UniqSupply
    -> DataCon
    -> [StgArg]
    -> [[PrimRep]]
    -> ([StgArg], Maybe (GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla))
    unariseUbxSumOrTupleArgs UnariseEnv
    rho UniqSupply
    us DataCon
    dc [StgArg]
    args [[PrimRep]]
    ty_args
      | DataCon -> Bool
    isUnboxedTupleDataCon DataCon
    dc
      = (UnariseEnv -> [StgArg] -> [StgArg]
    unariseConArgs UnariseEnv
    rho [StgArg]
    args, Maybe (GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    forall a. Maybe a
    Nothing)

      | DataCon -> Bool
    isUnboxedSumDataCon DataCon
    dc
      , let args1 :: [StgArg]
    args1 = Bool -> [StgArg] -> [StgArg]
    forall a. HasCallStack => Bool -> a -> a
    assert ([StgArg] -> Bool
    forall a. [a] -> Bool
    isSingleton [StgArg]
    args) (UnariseEnv -> [StgArg] -> [StgArg]
    unariseConArgs UnariseEnv
    rho [StgArg]
    args)
      = let ([StgArg]
    args2, GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla
    cast_wrapper) = HasDebugCallStack =>
    DataCon
    -> [[PrimRep]]
    -> [StgArg]
    -> UniqSupply
    -> ([StgArg], GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    DataCon
    -> [[PrimRep]]
    -> [StgArg]
    -> UniqSupply
    -> ([StgArg], GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    mkUbxSum DataCon
    dc [[PrimRep]]
    ty_args [StgArg]
    args1 UniqSupply
    us
        in ([StgArg]
    args2, (GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    -> Maybe (GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    forall a. a -> Maybe a
    Just GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla
    cast_wrapper)

      | Bool
    otherwise
      = String
    -> ([StgArg], Maybe (GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla))
    forall a. HasCallStack => String -> a
    panic String
    "unariseUbxSumOrTupleArgs: Constructor not a unboxed sum or tuple"

    -- Returns @Nothing@ if the given literal is already unary (exactly
    -- one PrimRep).  Doesn't return void args.
    --
    -- This needs to exist because rubbish literals can have any representation.
    -- See also Note [Rubbish literals] in GHC.Types.Literal.
    unariseLiteral_maybe :: Literal -> Maybe [OutStgArg]
    unariseLiteral_maybe :: Literal -> Maybe [StgArg]
    unariseLiteral_maybe (LitRubbish TypeOrConstraint
    torc Type
    rep)
      | [PrimRep
    _] <- [PrimRep]
    preps
      = Maybe [StgArg]
    forall a. Maybe a
    Nothing   -- Single PrimRep. Nothing to do!

      | Bool
    otherwise -- Multiple reps, or zero. Eliminate via elimCase
      = [StgArg] -> Maybe [StgArg]
    forall a. a -> Maybe a
    Just [ Literal -> StgArg
    StgLitArg (TypeOrConstraint -> Type -> Literal
    LitRubbish TypeOrConstraint
    torc (PrimRep -> Type
    primRepToRuntimeRep PrimRep
    prep))
             | PrimRep
    prep <- [PrimRep]
    preps ]
      where
        preps :: [PrimRep]
    preps = HasDebugCallStack => SDoc -> Type -> [PrimRep]
    SDoc -> Type -> [PrimRep]
    runtimeRepPrimRep (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "unariseLiteral_maybe") Type
    rep

    unariseLiteral_maybe Literal
    _ = Maybe [StgArg]
    forall a. Maybe a
    Nothing

    --------------------------------------------------------------------------------

    elimCase :: UnariseEnv
             -> [OutStgArg] -- non-void args
             -> InId -> AltType -> [InStgAlt] -> UniqSM OutStgExpr

    elimCase :: UnariseEnv
    -> [StgArg]
    -> Id
    -> AltType
    -> [GenStgAlt 'Vanilla]
    -> UniqSM (GenStgExpr 'Vanilla)
    elimCase UnariseEnv
    rho [StgArg]
    args Id
    bndr (MultiValAlt Int
    _) [GenStgAlt{ alt_con :: forall (pass :: StgPass). GenStgAlt pass -> AltCon
    alt_con   = AltCon
    _
                                                     , alt_bndrs :: forall (pass :: StgPass). GenStgAlt pass -> [BinderP pass]
    alt_bndrs = [BinderP 'Vanilla]
    bndrs
                                                     , alt_rhs :: forall (pass :: StgPass). GenStgAlt pass -> GenStgExpr pass
    alt_rhs   = GenStgExpr 'Vanilla
    rhs}]
      = do let rho1 :: UnariseEnv
    rho1 = UnariseEnv -> Id -> UnariseVal -> UnariseEnv
    extendRho UnariseEnv
    rho Id
    bndr ([StgArg] -> UnariseVal
    MultiVal [StgArg]
    args)
           (rho2, rhs') <- case () of
               ()
    _
                 | Id -> Bool
    isUnboxedTupleBndr Id
    bndr
                 -> (UnariseEnv, GenStgExpr 'Vanilla)
    -> UniqSM (UnariseEnv, GenStgExpr 'Vanilla)
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Id] -> [StgArg] -> UnariseEnv -> UnariseEnv
    mapTupleIdBinders [Id]
    [BinderP 'Vanilla]
    bndrs [StgArg]
    args UnariseEnv
    rho1, GenStgExpr 'Vanilla
    rhs)
                 | Bool
    otherwise
                 -> Bool
    -> UniqSM (UnariseEnv, GenStgExpr 'Vanilla)
    -> UniqSM (UnariseEnv, GenStgExpr 'Vanilla)
    forall a. HasCallStack => Bool -> a -> a
    assert (Id -> Bool
    isUnboxedSumBndr Id
    bndr) (UniqSM (UnariseEnv, GenStgExpr 'Vanilla)
     -> UniqSM (UnariseEnv, GenStgExpr 'Vanilla))
    -> UniqSM (UnariseEnv, GenStgExpr 'Vanilla)
    -> UniqSM (UnariseEnv, GenStgExpr 'Vanilla)
    forall a b. (a -> b) -> a -> b
    $
                   case [BinderP 'Vanilla]
    bndrs of
                    -- Sum with a void-type binder?
                    [] -> (UnariseEnv, GenStgExpr 'Vanilla)
    -> UniqSM (UnariseEnv, GenStgExpr 'Vanilla)
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (UnariseEnv
    rho1, GenStgExpr 'Vanilla
    rhs)
                    [BinderP 'Vanilla
    alt_bndr] -> Id
    -> [StgArg]
    -> GenStgExpr 'Vanilla
    -> UnariseEnv
    -> UniqSM (UnariseEnv, GenStgExpr 'Vanilla)
    mapSumIdBinders Id
    BinderP 'Vanilla
    alt_bndr [StgArg]
    args GenStgExpr 'Vanilla
    rhs UnariseEnv
    rho1
                    [BinderP 'Vanilla]
    _ -> String -> SDoc -> UniqSM (UnariseEnv, GenStgExpr 'Vanilla)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "mapSumIdBinders" ([Id] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Id]
    [BinderP 'Vanilla]
    bndrs SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ [StgArg] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [StgArg]
    args)

           unariseExpr rho2 rhs'

    elimCase UnariseEnv
    rho args :: [StgArg]
    args@(StgArg
    tag_arg : [StgArg]
    real_args) Id
    bndr (MultiValAlt Int
    _) [GenStgAlt 'Vanilla]
    alts
      | Id -> Bool
    isUnboxedSumBndr Id
    bndr
      = do tag_bndr <- FastString -> Type -> UniqSM Id
    mkId (String -> FastString
    mkFastString String
    "tag") Type
    tagTy
              -- this won't be used but we need a binder anyway
           let rho1 = UnariseEnv -> Id -> UnariseVal -> UnariseEnv
    extendRho UnariseEnv
    rho Id
    bndr ([StgArg] -> UnariseVal
    MultiVal [StgArg]
    args)
               scrut' = case StgArg
    tag_arg of
                          StgVarArg Id
    v     -> Id -> [StgArg] -> GenStgExpr 'Vanilla
    forall (pass :: StgPass). Id -> [StgArg] -> GenStgExpr pass
    StgApp Id
    v []
                          StgLitArg Literal
    l     -> Literal -> GenStgExpr 'Vanilla
    forall (pass :: StgPass). Literal -> GenStgExpr pass
    StgLit Literal
    l

           alts' <- unariseSumAlts rho1 real_args alts
           return (StgCase scrut' tag_bndr tagAltTy alts')

    elimCase UnariseEnv
    _ [StgArg]
    args Id
    bndr AltType
    alt_ty [GenStgAlt 'Vanilla]
    alts
      = String -> SDoc -> UniqSM (GenStgExpr 'Vanilla)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "elimCase - unhandled case"
          ([StgArg] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [StgArg]
    args SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    bndr SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> AltType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr AltType
    alt_ty SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ [GenStgAlt 'Vanilla] -> SDoc
    forall (pass :: StgPass).
    OutputablePass pass =>
    [GenStgAlt pass] -> SDoc
    pprPanicAlts [GenStgAlt 'Vanilla]
    alts)

    --------------------------------------------------------------------------------

    unariseAlts :: UnariseEnv -> AltType -> InId -> [StgAlt] -> UniqSM [StgAlt]
    unariseAlts :: UnariseEnv
    -> AltType
    -> Id
    -> [GenStgAlt 'Vanilla]
    -> UniqSM [GenStgAlt 'Vanilla]
    unariseAlts UnariseEnv
    rho (MultiValAlt Int
    n) Id
    bndr [GenStgAlt{ alt_con :: forall (pass :: StgPass). GenStgAlt pass -> AltCon
    alt_con   = AltCon
    DEFAULT
                                                   , alt_bndrs :: forall (pass :: StgPass). GenStgAlt pass -> [BinderP pass]
    alt_bndrs = []
                                                   , alt_rhs :: forall (pass :: StgPass). GenStgAlt pass -> GenStgExpr pass
    alt_rhs   = GenStgExpr 'Vanilla
    e}]
      | Id -> Bool
    isUnboxedTupleBndr Id
    bndr
      = do (rho', ys) <- UnariseEnv -> Id -> UniqSM (UnariseEnv, [Id])
    unariseConArgBinder UnariseEnv
    rho Id
    bndr
           !e' <- unariseExpr rho' e
           return [GenStgAlt (DataAlt (tupleDataCon Unboxed n)) ys e']

    unariseAlts UnariseEnv
    rho (MultiValAlt Int
    n) Id
    bndr [GenStgAlt{ alt_con :: forall (pass :: StgPass). GenStgAlt pass -> AltCon
    alt_con   = DataAlt DataCon
    _
                                                   , alt_bndrs :: forall (pass :: StgPass). GenStgAlt pass -> [BinderP pass]
    alt_bndrs = [BinderP 'Vanilla]
    ys
                                                   , alt_rhs :: forall (pass :: StgPass). GenStgAlt pass -> GenStgExpr pass
    alt_rhs   = GenStgExpr 'Vanilla
    e}]
      | Id -> Bool
    isUnboxedTupleBndr Id
    bndr
      = do (rho', ys1) <- UnariseEnv -> [Id] -> UniqSM (UnariseEnv, [Id])
    unariseConArgBinders UnariseEnv
    rho [Id]
    [BinderP 'Vanilla]
    ys
           massert (ys1 `lengthIs` n)
           let rho'' = UnariseEnv -> Id -> UnariseVal -> UnariseEnv
    extendRho UnariseEnv
    rho' Id
    bndr ([StgArg] -> UnariseVal
    MultiVal ((Id -> StgArg) -> [Id] -> [StgArg]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> StgArg
    StgVarArg [Id]
    ys1))
           !e' <- unariseExpr rho'' e
           return [GenStgAlt (DataAlt (tupleDataCon Unboxed n)) ys1 e']

    unariseAlts UnariseEnv
    _ (MultiValAlt Int
    _) Id
    bndr [GenStgAlt 'Vanilla]
    alts
      | Id -> Bool
    isUnboxedTupleBndr Id
    bndr
      = String -> SDoc -> UniqSM [GenStgAlt 'Vanilla]
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "unariseExpr: strange multi val alts" ([GenStgAlt 'Vanilla] -> SDoc
    forall (pass :: StgPass).
    OutputablePass pass =>
    [GenStgAlt pass] -> SDoc
    pprPanicAlts [GenStgAlt 'Vanilla]
    alts)

    -- In this case we don't need to scrutinize the tag bit
    unariseAlts UnariseEnv
    rho (MultiValAlt Int
    _) Id
    bndr [GenStgAlt{ alt_con :: forall (pass :: StgPass). GenStgAlt pass -> AltCon
    alt_con    = AltCon
    DEFAULT
                                                   , alt_bndrs :: forall (pass :: StgPass). GenStgAlt pass -> [BinderP pass]
    alt_bndrs = []
                                                   , alt_rhs :: forall (pass :: StgPass). GenStgAlt pass -> GenStgExpr pass
    alt_rhs   = GenStgExpr 'Vanilla
    rhs}]
      | Id -> Bool
    isUnboxedSumBndr Id
    bndr
      = do (rho_sum_bndrs, sum_bndrs) <- UnariseEnv -> Id -> UniqSM (UnariseEnv, [Id])
    unariseConArgBinder UnariseEnv
    rho Id
    bndr
           rhs' <- unariseExpr rho_sum_bndrs rhs
           return [GenStgAlt (DataAlt (tupleDataCon Unboxed (length sum_bndrs))) sum_bndrs rhs']

    unariseAlts UnariseEnv
    rho (MultiValAlt Int
    _) Id
    bndr [GenStgAlt 'Vanilla]
    alts
      | Id -> Bool
    isUnboxedSumBndr Id
    bndr
      = do (rho_sum_bndrs, scrt_bndrs@(tag_bndr : real_bndrs)) <- UnariseEnv -> Id -> UniqSM (UnariseEnv, [Id])
    unariseConArgBinder UnariseEnv
    rho Id
    bndr
           alts' <- unariseSumAlts rho_sum_bndrs (map StgVarArg real_bndrs) alts
           let inner_case = GenStgExpr 'Vanilla
    -> BinderP 'Vanilla
    -> AltType
    -> [GenStgAlt 'Vanilla]
    -> GenStgExpr 'Vanilla
    forall (pass :: StgPass).
    GenStgExpr pass
    -> BinderP pass -> AltType -> [GenStgAlt pass] -> GenStgExpr pass
    StgCase (Id -> [StgArg] -> GenStgExpr 'Vanilla
    forall (pass :: StgPass). Id -> [StgArg] -> GenStgExpr pass
    StgApp Id
    tag_bndr []) Id
    BinderP 'Vanilla
    tag_bndr AltType
    tagAltTy [GenStgAlt 'Vanilla]
    alts'
           return [GenStgAlt{ alt_con   = DataAlt (tupleDataCon Unboxed (length scrt_bndrs))
                            , alt_bndrs = scrt_bndrs
                            , alt_rhs   = inner_case
                            }]

    unariseAlts UnariseEnv
    rho AltType
    _ Id
    _ [GenStgAlt 'Vanilla]
    alts
      = (GenStgAlt 'Vanilla -> UniqSM (GenStgAlt 'Vanilla))
    -> [GenStgAlt 'Vanilla] -> UniqSM [GenStgAlt 'Vanilla]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (\GenStgAlt 'Vanilla
    alt -> UnariseEnv -> GenStgAlt 'Vanilla -> UniqSM (GenStgAlt 'Vanilla)
    unariseAlt UnariseEnv
    rho GenStgAlt 'Vanilla
    alt) [GenStgAlt 'Vanilla]
    alts

    unariseAlt :: UnariseEnv -> StgAlt -> UniqSM StgAlt
    unariseAlt :: UnariseEnv -> GenStgAlt 'Vanilla -> UniqSM (GenStgAlt 'Vanilla)
    unariseAlt UnariseEnv
    rho alt :: GenStgAlt 'Vanilla
    alt@GenStgAlt{alt_con :: forall (pass :: StgPass). GenStgAlt pass -> AltCon
    alt_con=AltCon
    _,alt_bndrs :: forall (pass :: StgPass). GenStgAlt pass -> [BinderP pass]
    alt_bndrs=[BinderP 'Vanilla]
    xs,alt_rhs :: forall (pass :: StgPass). GenStgAlt pass -> GenStgExpr pass
    alt_rhs=GenStgExpr 'Vanilla
    e}
      = do (rho', xs') <- UnariseEnv -> [Id] -> UniqSM (UnariseEnv, [Id])
    unariseConArgBinders UnariseEnv
    rho [Id]
    [BinderP 'Vanilla]
    xs
           !e' <- unariseExpr rho' e
           return $! alt {alt_bndrs = xs', alt_rhs = e'}

    --------------------------------------------------------------------------------

    -- | Make alternatives that match on the tag of a sum
    -- (i.e. generate LitAlts for the tag)
    unariseSumAlts :: UnariseEnv
                   -> [StgArg] -- sum components _excluding_ the tag bit.
                   -> [StgAlt] -- original alternative with sum LHS
                   -> UniqSM [StgAlt]
    unariseSumAlts :: UnariseEnv
    -> [StgArg] -> [GenStgAlt 'Vanilla] -> UniqSM [GenStgAlt 'Vanilla]
    unariseSumAlts UnariseEnv
    env [StgArg]
    args [GenStgAlt 'Vanilla]
    alts
      = do alts' <- (GenStgAlt 'Vanilla -> UniqSM (GenStgAlt 'Vanilla))
    -> [GenStgAlt 'Vanilla] -> UniqSM [GenStgAlt 'Vanilla]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (UnariseEnv
    -> [StgArg] -> GenStgAlt 'Vanilla -> UniqSM (GenStgAlt 'Vanilla)
    unariseSumAlt UnariseEnv
    env [StgArg]
    args) [GenStgAlt 'Vanilla]
    alts
           return (mkDefaultLitAlt alts')

    unariseSumAlt :: UnariseEnv
                  -> [StgArg] -- sum components _excluding_ the tag bit.
                  -> StgAlt   -- original alternative with sum LHS
                  -> UniqSM StgAlt
    unariseSumAlt :: UnariseEnv
    -> [StgArg] -> GenStgAlt 'Vanilla -> UniqSM (GenStgAlt 'Vanilla)
    unariseSumAlt UnariseEnv
    rho [StgArg]
    _ GenStgAlt{alt_con :: forall (pass :: StgPass). GenStgAlt pass -> AltCon
    alt_con=AltCon
    DEFAULT,alt_bndrs :: forall (pass :: StgPass). GenStgAlt pass -> [BinderP pass]
    alt_bndrs=[BinderP 'Vanilla]
    _,alt_rhs :: forall (pass :: StgPass). GenStgAlt pass -> GenStgExpr pass
    alt_rhs=GenStgExpr 'Vanilla
    e}
      = AltCon
    -> [BinderP 'Vanilla] -> GenStgExpr 'Vanilla -> GenStgAlt 'Vanilla
    forall (pass :: StgPass).
    AltCon -> [BinderP pass] -> GenStgExpr pass -> GenStgAlt pass
    GenStgAlt AltCon
    DEFAULT [Id]
    [BinderP 'Vanilla]
    forall a. Monoid a => a
    mempty (GenStgExpr 'Vanilla -> GenStgAlt 'Vanilla)
    -> UniqSM (GenStgExpr 'Vanilla) -> UniqSM (GenStgAlt 'Vanilla)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> UnariseEnv -> GenStgExpr 'Vanilla -> UniqSM (GenStgExpr 'Vanilla)
    unariseExpr UnariseEnv
    rho GenStgExpr 'Vanilla
    e

    unariseSumAlt UnariseEnv
    rho [StgArg]
    args alt :: GenStgAlt 'Vanilla
    alt@GenStgAlt{ alt_con :: forall (pass :: StgPass). GenStgAlt pass -> AltCon
    alt_con   = DataAlt DataCon
    sumCon
                                    , alt_bndrs :: forall (pass :: StgPass). GenStgAlt pass -> [BinderP pass]
    alt_bndrs = [BinderP 'Vanilla]
    bs
                                    , alt_rhs :: forall (pass :: StgPass). GenStgAlt pass -> GenStgExpr pass
    alt_rhs   = GenStgExpr 'Vanilla
    e
                                    }

      = do (rho',e') <- case [BinderP 'Vanilla]
    bs of
                  [BinderP 'Vanilla
    b] -> Id
    -> [StgArg]
    -> GenStgExpr 'Vanilla
    -> UnariseEnv
    -> UniqSM (UnariseEnv, GenStgExpr 'Vanilla)
    mapSumIdBinders Id
    BinderP 'Vanilla
    b [StgArg]
    args GenStgExpr 'Vanilla
    e UnariseEnv
    rho
                  -- Sums must have one binder
                  [BinderP 'Vanilla]
    _ -> String -> SDoc -> UniqSM (UnariseEnv, GenStgExpr 'Vanilla)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "unariseSumAlt2" ([StgArg] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [StgArg]
    args SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ GenStgAlt 'Vanilla -> SDoc
    forall (pass :: StgPass).
    OutputablePass pass =>
    GenStgAlt pass -> SDoc
    pprPanicAlt GenStgAlt 'Vanilla
    alt)
           let lit_case   = Literal -> AltCon
    LitAlt (LitNumType -> Integer -> Literal
    LitNumber LitNumType
    LitNumInt (Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (DataCon -> Int
    dataConTag DataCon
    sumCon)))
           GenStgAlt lit_case mempty <$> unariseExpr rho' e'

    unariseSumAlt UnariseEnv
    _ [StgArg]
    scrt GenStgAlt 'Vanilla
    alt
      = String -> SDoc -> UniqSM (GenStgAlt 'Vanilla)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "unariseSumAlt3" ([StgArg] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [StgArg]
    scrt SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ GenStgAlt 'Vanilla -> SDoc
    forall (pass :: StgPass).
    OutputablePass pass =>
    GenStgAlt pass -> SDoc
    pprPanicAlt GenStgAlt 'Vanilla
    alt)

    --------------------------------------------------------------------------------
    -- Mapping binders when matching und a unboxed sum/tuple

    mapTupleIdBinders
      :: [InId]       -- Un-processed binders of a tuple alternative.
                      -- Can have void binders.
      -> [OutStgArg]  -- Arguments that form the tuple (after unarisation).
                      -- Can't have void args.
      -> UnariseEnv
      -> UnariseEnv
    mapTupleIdBinders :: [Id] -> [StgArg] -> UnariseEnv -> UnariseEnv
    mapTupleIdBinders [Id]
    ids [StgArg]
    args0 UnariseEnv
    rho0
      = Bool -> UnariseEnv -> UnariseEnv
    forall a. HasCallStack => Bool -> a -> a
    assert (Bool -> Bool
    not ((StgArg -> Bool) -> [StgArg] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ([PrimRep] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([PrimRep] -> Bool) -> (StgArg -> [PrimRep]) -> StgArg -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StgArg -> [PrimRep]
    stgArgRep) [StgArg]
    args0)) (UnariseEnv -> UnariseEnv) -> UnariseEnv -> UnariseEnv
    forall a b. (a -> b) -> a -> b
    $
        let
          map_ids :: UnariseEnv -> [Id] -> [StgArg] -> UnariseEnv
          map_ids :: UnariseEnv -> [Id] -> [StgArg] -> UnariseEnv
    map_ids UnariseEnv
    rho [] [StgArg]
    _  = UnariseEnv
    rho
          map_ids UnariseEnv
    rho (Id
    x : [Id]
    xs) [StgArg]
    args =
            let
              x_reps :: [PrimRep]
    x_reps = HasDebugCallStack => Type -> [PrimRep]
    Type -> [PrimRep]
    typePrimRep (Id -> Type
    idType Id
    x)
              x_arity :: Int
    x_arity = [PrimRep] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [PrimRep]
    x_reps
              ([StgArg]
    x_args, [StgArg]
    args') =
                Bool
    -> (Int -> [StgArg] -> ([StgArg], [StgArg]))
    -> Int
    -> [StgArg]
    -> ([StgArg], [StgArg])
    forall a. HasCallStack => Bool -> a -> a
    assert ([StgArg]
    args [StgArg] -> Int -> Bool
    forall a. [a] -> Int -> Bool
    `lengthAtLeast` Int
    x_arity)
                Int -> [StgArg] -> ([StgArg], [StgArg])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    x_arity [StgArg]
    args

              rho' :: UnariseEnv
    rho'
                | Int
    x_arity Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1
                = Bool
    -> (UnariseEnv -> Id -> UnariseVal -> UnariseEnv)
    -> UnariseEnv
    -> Id
    -> UnariseVal
    -> UnariseEnv
    forall a. HasCallStack => Bool -> a -> a
    assert ([StgArg]
    x_args [StgArg] -> Int -> Bool
    forall a. [a] -> Int -> Bool
    `lengthIs` Int
    1)
                  UnariseEnv -> Id -> UnariseVal -> UnariseEnv
    extendRho UnariseEnv
    rho Id
    x (StgArg -> UnariseVal
    UnaryVal ([StgArg] -> StgArg
    forall a. HasCallStack => [a] -> a
    head [StgArg]
    x_args))
                | Bool
    otherwise
                = UnariseEnv -> Id -> UnariseVal -> UnariseEnv
    extendRho UnariseEnv
    rho Id
    x ([StgArg] -> UnariseVal
    MultiVal [StgArg]
    x_args)
            in
              UnariseEnv -> [Id] -> [StgArg] -> UnariseEnv
    map_ids UnariseEnv
    rho' [Id]
    xs [StgArg]
    args'
        in
          UnariseEnv -> [Id] -> [StgArg] -> UnariseEnv
    map_ids UnariseEnv
    rho0 [Id]
    ids [StgArg]
    args0

    mapSumIdBinders
      :: InId        -- Binder (in the case alternative).
      -> [OutStgArg] -- Arguments that form the sum (NOT including the tag).
                     -- Can't have void args.
      -> InStgExpr
      -> UnariseEnv
      -> UniqSM (UnariseEnv, OutStgExpr)

    mapSumIdBinders :: Id
    -> [StgArg]
    -> GenStgExpr 'Vanilla
    -> UnariseEnv
    -> UniqSM (UnariseEnv, GenStgExpr 'Vanilla)
    mapSumIdBinders Id
    alt_bndr [StgArg]
    args GenStgExpr 'Vanilla
    rhs UnariseEnv
    rho0
      = Bool
    -> UniqSM (UnariseEnv, GenStgExpr 'Vanilla)
    -> UniqSM (UnariseEnv, GenStgExpr 'Vanilla)
    forall a. HasCallStack => Bool -> a -> a
    assert (Bool -> Bool
    not ((StgArg -> Bool) -> [StgArg] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ([PrimRep] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([PrimRep] -> Bool) -> (StgArg -> [PrimRep]) -> StgArg -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StgArg -> [PrimRep]
    stgArgRep) [StgArg]
    args)) (UniqSM (UnariseEnv, GenStgExpr 'Vanilla)
     -> UniqSM (UnariseEnv, GenStgExpr 'Vanilla))
    -> UniqSM (UnariseEnv, GenStgExpr 'Vanilla)
    -> UniqSM (UnariseEnv, GenStgExpr 'Vanilla)
    forall a b. (a -> b) -> a -> b
    $ do
        uss <- UniqSupply -> [UniqSupply]
    listSplitUniqSupply (UniqSupply -> [UniqSupply])
    -> UniqSM UniqSupply -> UniqSM [UniqSupply]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> UniqSM UniqSupply
    forall (m :: * -> *). MonadUnique m => m UniqSupply
    getUniqueSupplyM
        let
          fld_reps = HasDebugCallStack => Type -> [PrimRep]
    Type -> [PrimRep]
    typePrimRep (Id -> Type
    idType Id
    alt_bndr)

          -- Slots representing the whole sum
          arg_slots = (PrimRep -> SlotTy) -> [PrimRep] -> [SlotTy]
    forall a b. (a -> b) -> [a] -> [b]
    map PrimRep -> SlotTy
    primRepSlot ([PrimRep] -> [SlotTy]) -> [PrimRep] -> [SlotTy]
    forall a b. (a -> b) -> a -> b
    $ (StgArg -> [PrimRep]) -> [StgArg] -> [PrimRep]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap StgArg -> [PrimRep]
    stgArgRep [StgArg]
    args
          -- The slots representing the field of the sum we bind.
          id_slots  = (PrimRep -> SlotTy) -> [PrimRep] -> [SlotTy]
    forall a b. (a -> b) -> [a] -> [b]
    map PrimRep -> SlotTy
    primRepSlot ([PrimRep] -> [SlotTy]) -> [PrimRep] -> [SlotTy]
    forall a b. (a -> b) -> a -> b
    $ [PrimRep]
    fld_reps
          layout1   = [SlotTy] -> [SlotTy] -> [Int]
    HasDebugCallStack => [SlotTy] -> [SlotTy] -> [Int]
    layoutUbxSum [SlotTy]
    arg_slots [SlotTy]
    id_slots

          -- See Note [Casting slot arguments]
          -- Most of the code here is just to make sure our binders are of the
          -- right type.
          -- Select only the args which contain parts of the current field.
          id_arg_exprs   = [ [StgArg]
    args [StgArg] -> Int -> StgArg
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    i | Int
    i <- [Int]
    layout1 ]
          id_vars   = [Id
    v | StgVarArg Id
    v <- [StgArg]
    id_arg_exprs]

          typed_id_arg_input = Bool -> [(Id, PrimRep, UniqSupply)] -> [(Id, PrimRep, UniqSupply)]
    forall a. HasCallStack => Bool -> a -> a
    assert ([Id] -> [PrimRep] -> Bool
    forall a b. [a] -> [b] -> Bool
    equalLength [Id]
    id_vars [PrimRep]
    fld_reps) ([(Id, PrimRep, UniqSupply)] -> [(Id, PrimRep, UniqSupply)])
    -> [(Id, PrimRep, UniqSupply)] -> [(Id, PrimRep, UniqSupply)]
    forall a b. (a -> b) -> a -> b
    $
                               [Id] -> [PrimRep] -> [UniqSupply] -> [(Id, PrimRep, UniqSupply)]
    forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
    zip3 [Id]
    id_vars [PrimRep]
    fld_reps [UniqSupply]
    uss

          mkCastInput :: (Id,PrimRep,UniqSupply) -> ([(PrimOp,Type,Unique)],Id,Id)
          mkCastInput (Id
    id,PrimRep
    rep,UniqSupply
    bndr_us) =
            let ([PrimOp]
    ops,[Type]
    types) = [(PrimOp, Type)] -> ([PrimOp], [Type])
    forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
    unzip ([(PrimOp, Type)] -> ([PrimOp], [Type]))
    -> [(PrimOp, Type)] -> ([PrimOp], [Type])
    forall a b. (a -> b) -> a -> b
    $ PrimRep -> PrimRep -> [(PrimOp, Type)]
    getCasts (HasDebugCallStack => Type -> PrimRep
    Type -> PrimRep
    typePrimRepU (Type -> PrimRep) -> Type -> PrimRep
    forall a b. (a -> b) -> a -> b
    $ Id -> Type
    idType Id
    id) PrimRep
    rep
                cst_opts :: [(PrimOp, Type, Unique)]
    cst_opts = [PrimOp] -> [Type] -> [Unique] -> [(PrimOp, Type, Unique)]
    forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
    zip3 [PrimOp]
    ops [Type]
    types ([Unique] -> [(PrimOp, Type, Unique)])
    -> [Unique] -> [(PrimOp, Type, Unique)]
    forall a b. (a -> b) -> a -> b
    $ UniqSupply -> [Unique]
    uniqsFromSupply UniqSupply
    bndr_us
                out_id :: Id
    out_id = case [(PrimOp, Type, Unique)]
    cst_opts of
                  [] -> Id
    id
                  [(PrimOp, Type, Unique)]
    _ ->  let (PrimOp
    _,Type
    ty,Unique
    uq) = [(PrimOp, Type, Unique)] -> (PrimOp, Type, Unique)
    forall a. HasCallStack => [a] -> a
    last [(PrimOp, Type, Unique)]
    cst_opts
                        in Unique -> Type -> Id
    mkCastVar Unique
    uq Type
    ty
            in ([(PrimOp, Type, Unique)]
    cst_opts,Id
    id,Id
    out_id)

          cast_inputs = ((Id, PrimRep, UniqSupply) -> ([(PrimOp, Type, Unique)], Id, Id))
    -> [(Id, PrimRep, UniqSupply)]
    -> [([(PrimOp, Type, Unique)], Id, Id)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Id, PrimRep, UniqSupply) -> ([(PrimOp, Type, Unique)], Id, Id)
    mkCastInput [(Id, PrimRep, UniqSupply)]
    typed_id_arg_input
          (rhs_with_casts,typed_ids) = mapAccumL cast_arg (\GenStgExpr 'Vanilla
    x->GenStgExpr 'Vanilla
    x) cast_inputs
            where
              cast_arg GenStgExpr 'Vanilla -> c
    rhs_in ([(PrimOp, Type, Unique)]
    cast_ops,Id
    in_id,b
    out_id) =
                let rhs_out :: GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla
    rhs_out = [(PrimOp, Type, Unique)]
    -> StgArg -> GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla
    castArgRename [(PrimOp, Type, Unique)]
    cast_ops (Id -> StgArg
    StgVarArg Id
    in_id)
                in (GenStgExpr 'Vanilla -> c
    rhs_in (GenStgExpr 'Vanilla -> c)
    -> (GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    -> GenStgExpr 'Vanilla
    -> c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla
    rhs_out, b
    out_id)

          typed_id_args = (Id -> StgArg) -> [Id] -> [StgArg]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> StgArg
    StgVarArg [Id]
    typed_ids

          -- pprTrace "mapSumIdBinders"
          --           (text "fld_reps" <+> ppr fld_reps $$
          --           text "id_args" <+> ppr id_arg_exprs $$
          --           text "rhs" <+> ppr rhs $$
          --           text "rhs_with_casts" <+> ppr rhs_with_casts
          --           ) $
        if isMultiValBndr alt_bndr
          then return (extendRho rho0 alt_bndr (MultiVal typed_id_args), rhs_with_casts rhs)
          else assert (typed_id_args `lengthIs` 1) $
                return (extendRho rho0 alt_bndr (UnaryVal (head typed_id_args)), rhs_with_casts rhs)

    -- Convert the argument to the given type, and wrap the conversion
    -- around the given expression. Use the given Id as a name for the
    -- converted value.
    castArgRename :: [(PrimOp,Type,Unique)] -> StgArg -> StgExpr -> StgExpr
    castArgRename :: [(PrimOp, Type, Unique)]
    -> StgArg -> GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla
    castArgRename [(PrimOp, Type, Unique)]
    ops StgArg
    in_arg GenStgExpr 'Vanilla
    rhs =
      case [(PrimOp, Type, Unique)]
    ops of
        [] -> GenStgExpr 'Vanilla
    rhs
        ((PrimOp
    op,Type
    ty,Unique
    uq):[(PrimOp, Type, Unique)]
    rest_ops) ->
          let out_id' :: Id
    out_id' = Unique -> Type -> Id
    mkCastVar Unique
    uq Type
    ty -- out_name `setIdUnique` uq `setIdType` ty
              sub_cast :: GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla
    sub_cast = [(PrimOp, Type, Unique)]
    -> StgArg -> GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla
    castArgRename [(PrimOp, Type, Unique)]
    rest_ops (Id -> StgArg
    StgVarArg Id
    out_id')
          in StgArg
    -> PrimOp
    -> Id
    -> Type
    -> GenStgExpr 'Vanilla
    -> GenStgExpr 'Vanilla
    mkCast StgArg
    in_arg PrimOp
    op Id
    out_id' Type
    ty (GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    -> GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla
    forall a b. (a -> b) -> a -> b
    $ GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla
    sub_cast GenStgExpr 'Vanilla
    rhs

    -- Construct a case binder used when casting sums, of a given type and unique.
    mkCastVar :: Unique -> Type -> Id
    mkCastVar :: Unique -> Type -> Id
    mkCastVar Unique
    uq Type
    ty = FastString -> Unique -> Type -> Type -> Id
    mkSysLocal (String -> FastString
    fsLit String
    "cst_sum") Unique
    uq Type
    ManyTy Type
    ty

    mkCast :: StgArg -> PrimOp -> OutId -> Type -> StgExpr -> StgExpr
    mkCast :: StgArg
    -> PrimOp
    -> Id
    -> Type
    -> GenStgExpr 'Vanilla
    -> GenStgExpr 'Vanilla
    mkCast StgArg
    arg_in PrimOp
    cast_op Id
    out_id Type
    out_ty GenStgExpr 'Vanilla
    in_rhs =
      let r2 :: PrimRep
    r2 = HasDebugCallStack => Type -> PrimRep
    Type -> PrimRep
    typePrimRepU Type
    out_ty
          scrut :: GenStgExpr 'Vanilla
    scrut = StgOp -> [StgArg] -> Type -> GenStgExpr 'Vanilla
    forall (pass :: StgPass).
    StgOp -> [StgArg] -> Type -> GenStgExpr pass
    StgOpApp (PrimOp -> StgOp
    StgPrimOp PrimOp
    cast_op) [StgArg
    arg_in] Type
    out_ty
          alt :: GenStgAlt 'Vanilla
    alt = GenStgAlt { alt_con :: AltCon
    alt_con = AltCon
    DEFAULT, alt_bndrs :: [BinderP 'Vanilla]
    alt_bndrs = [], alt_rhs :: GenStgExpr 'Vanilla
    alt_rhs = GenStgExpr 'Vanilla
    in_rhs}
          alt_ty :: AltType
    alt_ty = PrimRep -> AltType
    PrimAlt PrimRep
    r2
      in (GenStgExpr 'Vanilla
    -> BinderP 'Vanilla
    -> AltType
    -> [GenStgAlt 'Vanilla]
    -> GenStgExpr 'Vanilla
    forall (pass :: StgPass).
    GenStgExpr pass
    -> BinderP pass -> AltType -> [GenStgAlt pass] -> GenStgExpr pass
    StgCase GenStgExpr 'Vanilla
    scrut Id
    BinderP 'Vanilla
    out_id AltType
    alt_ty [GenStgAlt 'Vanilla
    alt])

    -- | Build a unboxed sum term from arguments of an alternative.
    --
    -- Example, for (# x | #) :: (# (# #) | Int #) we call
    --
    --   mkUbxSum (# _ | #) [ [], [LiftedRep] ] [ voidPrimId ]
    --
    -- which returns
    --
    --   [ 1#, rubbish ]
    --
    mkUbxSum
      :: HasDebugCallStack
      => DataCon      -- Sum data con
      -> [[PrimRep]]  -- Representations of type arguments of the sum data con
      -> [OutStgArg]  -- Actual arguments of the alternative.
      -> UniqSupply
      -> ([OutStgArg] -- Final tuple arguments
         ,(StgExpr->StgExpr) -- We might need to cast the args first
         )
    mkUbxSum :: HasDebugCallStack =>
    DataCon
    -> [[PrimRep]]
    -> [StgArg]
    -> UniqSupply
    -> ([StgArg], GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    mkUbxSum DataCon
    dc [[PrimRep]]
    ty_args [StgArg]
    args0 UniqSupply
    us
      = let
          SlotTy
    _ :| [SlotTy]
    sum_slots = [[PrimRep]] -> NonEmpty SlotTy
    ubxSumRepType [[PrimRep]]
    ty_args
          -- drop tag slot
          field_slots :: [SlotTy]
    field_slots = ((StgArg -> Maybe SlotTy) -> [StgArg] -> [SlotTy]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe ([PrimRep] -> Maybe SlotTy
    repSlotTy ([PrimRep] -> Maybe SlotTy)
    -> (StgArg -> [PrimRep]) -> StgArg -> Maybe SlotTy
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StgArg -> [PrimRep]
    stgArgRep) [StgArg]
    args0)
          tag :: Int
    tag = DataCon -> Int
    dataConTag DataCon
    dc
          layout' :: [Int]
    layout'  = [SlotTy] -> [SlotTy] -> [Int]
    HasDebugCallStack => [SlotTy] -> [SlotTy] -> [Int]
    layoutUbxSum [SlotTy]
    sum_slots [SlotTy]
    field_slots

          tag_arg :: StgArg
    tag_arg  = Literal -> StgArg
    StgLitArg (LitNumType -> Integer -> Literal
    LitNumber LitNumType
    LitNumInt (Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    tag))
          arg_idxs :: IntMap StgArg
    arg_idxs = [(Int, StgArg)] -> IntMap StgArg
    forall a. [(Int, a)] -> IntMap a
    IM.fromList ([Int] -> [StgArg] -> [(Int, StgArg)]
    forall a b. HasDebugCallStack => [a] -> [b] -> [(a, b)]
    zipEqual [Int]
    layout' [StgArg]
    args0)

          ((Int
    _idx,IntMap StgArg
    _idx_map,UniqSupply
    _us,GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla
    wrapper),[StgArg]
    slot_args)
            = Bool
    -> ((Int, IntMap StgArg, UniqSupply,
         GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla),
        [StgArg])
    -> ((Int, IntMap StgArg, UniqSupply,
         GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla),
        [StgArg])
    forall a. HasCallStack => Bool -> a -> a
    assert (IntMap StgArg -> Int
    forall a. IntMap a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length IntMap StgArg
    arg_idxs Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= [SlotTy] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [SlotTy]
    sum_slots ) (((Int, IntMap StgArg, UniqSupply,
       GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla),
      [StgArg])
     -> ((Int, IntMap StgArg, UniqSupply,
          GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla),
         [StgArg]))
    -> ((Int, IntMap StgArg, UniqSupply,
         GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla),
        [StgArg])
    -> ((Int, IntMap StgArg, UniqSupply,
         GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla),
        [StgArg])
    forall a b. (a -> b) -> a -> b
    $
              ((Int, IntMap StgArg, UniqSupply,
      GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
     -> SlotTy
     -> ((Int, IntMap StgArg, UniqSupply,
          GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla),
         StgArg))
    -> (Int, IntMap StgArg, UniqSupply,
        GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    -> [SlotTy]
    -> ((Int, IntMap StgArg, UniqSupply,
         GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla),
        [StgArg])
    forall (t :: * -> *) s a b.
    Traversable t =>
    (s -> a -> (s, b)) -> s -> t a -> (s, t b)
    mapAccumL (Int, IntMap StgArg, UniqSupply,
     GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    -> SlotTy
    -> ((Int, IntMap StgArg, UniqSupply,
         GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla),
        StgArg)
    mkTupArg (Int
    0,IntMap StgArg
    arg_idxs,UniqSupply
    us,GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla
    forall a. a -> a
    id) [SlotTy]
    sum_slots

          mkTupArg  :: (Int, IM.IntMap StgArg,UniqSupply,StgExpr->StgExpr)
                    -> SlotTy
                    -> ((Int,IM.IntMap StgArg,UniqSupply,StgExpr->StgExpr), StgArg)
          mkTupArg :: (Int, IntMap StgArg, UniqSupply,
     GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    -> SlotTy
    -> ((Int, IntMap StgArg, UniqSupply,
         GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla),
        StgArg)
    mkTupArg (Int
    arg_idx, IntMap StgArg
    arg_map, UniqSupply
    us, GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla
    wrapper) SlotTy
    slot
             | Just StgArg
    stg_arg <- Int -> IntMap StgArg -> Maybe StgArg
    forall a. Int -> IntMap a -> Maybe a
    IM.lookup Int
    arg_idx IntMap StgArg
    arg_map
             =  case UniqSupply
    -> SlotTy
    -> StgArg
    -> Maybe
         (StgArg, UniqSupply, GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    castArg UniqSupply
    us SlotTy
    slot StgArg
    stg_arg of
                  -- Slot and arg type mismatched, do a cast
                  Just (StgArg
    casted_arg,UniqSupply
    us',GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla
    wrapper') ->
                    ( (Int
    arg_idxInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1, IntMap StgArg
    arg_map, UniqSupply
    us', GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla
    wrapper (GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    -> (GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    -> GenStgExpr 'Vanilla
    -> GenStgExpr 'Vanilla
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla
    wrapper')
                    , StgArg
    casted_arg)
                  -- Use the arg as-is
                  Maybe
      (StgArg, UniqSupply, GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    Nothing ->
                    ( (Int
    arg_idxInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1, IntMap StgArg
    arg_map, UniqSupply
    us, GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla
    wrapper)
                    , StgArg
    stg_arg)
             -- Garbage slot, fill with rubbish
             | Bool
    otherwise
             =  ( (Int
    arg_idxInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1, IntMap StgArg
    arg_map, UniqSupply
    us, GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla
    wrapper)
                , SlotTy -> StgArg
    ubxSumRubbishArg SlotTy
    slot)

          castArg :: UniqSupply -> SlotTy -> StgArg -> Maybe (StgArg,UniqSupply,StgExpr -> StgExpr)
          castArg :: UniqSupply
    -> SlotTy
    -> StgArg
    -> Maybe
         (StgArg, UniqSupply, GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    castArg UniqSupply
    us SlotTy
    slot_ty StgArg
    arg
            -- Cast the argument to the type of the slot if required
            | SlotTy -> PrimRep
    slotPrimRep SlotTy
    slot_ty PrimRep -> PrimRep -> Bool
    forall a. Eq a => a -> a -> Bool
    /= StgArg -> PrimRep
    stgArgRepU StgArg
    arg
            , ([PrimOp]
    ops,[Type]
    types) <- [(PrimOp, Type)] -> ([PrimOp], [Type])
    forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
    unzip ([(PrimOp, Type)] -> ([PrimOp], [Type]))
    -> [(PrimOp, Type)] -> ([PrimOp], [Type])
    forall a b. (a -> b) -> a -> b
    $ PrimRep -> PrimRep -> [(PrimOp, Type)]
    getCasts (StgArg -> PrimRep
    stgArgRepU StgArg
    arg) (PrimRep -> [(PrimOp, Type)]) -> PrimRep -> [(PrimOp, Type)]
    forall a b. (a -> b) -> a -> b
    $ SlotTy -> PrimRep
    slotPrimRep SlotTy
    slot_ty
            , Bool -> Bool
    not (Bool -> Bool) -> ([PrimOp] -> Bool) -> [PrimOp] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [PrimOp] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([PrimOp] -> Bool) -> [PrimOp] -> Bool
    forall a b. (a -> b) -> a -> b
    $ [PrimOp]
    ops
            = let (UniqSupply
    us1,UniqSupply
    us2) = UniqSupply -> (UniqSupply, UniqSupply)
    splitUniqSupply UniqSupply
    us
                  cast_uqs :: [Unique]
    cast_uqs = UniqSupply -> [Unique]
    uniqsFromSupply UniqSupply
    us1
                  cast_opts :: [(PrimOp, Type, Unique)]
    cast_opts = [PrimOp] -> [Type] -> [Unique] -> [(PrimOp, Type, Unique)]
    forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
    zip3 [PrimOp]
    ops [Type]
    types [Unique]
    cast_uqs
                  (PrimOp
    _op,Type
    out_ty,Unique
    out_uq) = [(PrimOp, Type, Unique)] -> (PrimOp, Type, Unique)
    forall a. HasCallStack => [a] -> a
    last [(PrimOp, Type, Unique)]
    cast_opts
                  casts :: GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla
    casts = [(PrimOp, Type, Unique)]
    -> StgArg -> GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla
    castArgRename [(PrimOp, Type, Unique)]
    cast_opts StgArg
    arg :: StgExpr -> StgExpr
              in (StgArg, UniqSupply, GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    -> Maybe
         (StgArg, UniqSupply, GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    forall a. a -> Maybe a
    Just (Id -> StgArg
    StgVarArg (Unique -> Type -> Id
    mkCastVar Unique
    out_uq Type
    out_ty),UniqSupply
    us2,GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla
    casts)
            -- No need for casting
            | Bool
    otherwise = Maybe
      (StgArg, UniqSupply, GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla)
    forall a. Maybe a
    Nothing

          tup_args :: [StgArg]
    tup_args = StgArg
    tag_arg StgArg -> [StgArg] -> [StgArg]
    forall a. a -> [a] -> [a]
    : [StgArg]
    slot_args
        in
          -- pprTrace "mkUbxSum" (
          --   text "ty_args (slots)" <+> ppr ty_args $$
          --   text "args0" <+> ppr args0 $$
          --   text "wrapper" <+>
          --       (ppr $ wrapper $ StgLit $ LitChar '_'))
          ([StgArg]
    tup_args, GenStgExpr 'Vanilla -> GenStgExpr 'Vanilla
    wrapper)

    -- | Return a rubbish value for the given slot type.
    --
    -- We use the following rubbish values:
    --    * Literals: 0 or 0.0
    --    * Pointers: `ghc-prim:GHC.Prim.Panic.absentSumFieldError`
    --
    -- See Note [aBSENT_SUM_FIELD_ERROR_ID] in "GHC.Core.Make"
    --
    ubxSumRubbishArg :: SlotTy -> StgArg
    ubxSumRubbishArg :: SlotTy -> StgArg
    ubxSumRubbishArg SlotTy
    PtrLiftedSlot   = Id -> StgArg
    StgVarArg Id
    aBSENT_SUM_FIELD_ERROR_ID
    ubxSumRubbishArg SlotTy
    PtrUnliftedSlot = Id -> StgArg
    StgVarArg Id
    aBSENT_SUM_FIELD_ERROR_ID
    ubxSumRubbishArg SlotTy
    WordSlot        = Literal -> StgArg
    StgLitArg (LitNumType -> Integer -> Literal
    LitNumber LitNumType
    LitNumWord Integer
    0)
    ubxSumRubbishArg SlotTy
    Word64Slot      = Literal -> StgArg
    StgLitArg (LitNumType -> Integer -> Literal
    LitNumber LitNumType
    LitNumWord64 Integer
    0)
    ubxSumRubbishArg SlotTy
    FloatSlot       = Literal -> StgArg
    StgLitArg (Rational -> Literal
    LitFloat Rational
    0)
    ubxSumRubbishArg SlotTy
    DoubleSlot      = Literal -> StgArg
    StgLitArg (Rational -> Literal
    LitDouble Rational
    0)
    ubxSumRubbishArg (VecSlot Int
    n PrimElemRep
    e)   = Literal -> StgArg
    StgLitArg (TypeOrConstraint -> Type -> Literal
    LitRubbish TypeOrConstraint
    TypeLike Type
    vec_rep)
      where vec_rep :: Type
    vec_rep = PrimRep -> Type
    primRepToRuntimeRep (Int -> PrimElemRep -> PrimRep
    VecRep Int
    n PrimElemRep
    e)

    --------------------------------------------------------------------------------

    {-
    Note [Unarisation of Void binders and arguments]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    For arguments (StgArg) and binders (Id) we have two kind of unarisation:

      - When unarising function arg binders and arguments, we don't want to remove
        void binders and arguments. For example,

          f :: (# (# #), (# #) #) -> Void# -> State# RealWorld -> ...
          f x y z = <body>

        Here after unarise we should still get a function with arity 3. Similarly
        in the call site we shouldn't remove void arguments:

          f (# (# #), (# #) #) void# realWorld#

        When unarising <body>, we extend the environment with these binders:

          x :-> MultiVal [], y :-> MultiVal [], z :-> MultiVal []

        Because their rep types are `MultiRep []` (aka. void). This means that when
        we see `x` in a function argument position, we actually replace it with a
        void argument. When we see it in a DataCon argument position, we just get
        rid of it, because DataCon applications in STG are always saturated.

      - When unarising case alternative binders we remove void binders, but we
        still update the environment the same way, because those binders may be
        used in the RHS. Example:

          case x of y {
            (# x1, x2, x3 #) -> <RHS>
          }

        We know that y can't be void, because we don't scrutinize voids, so x will
        be unarised to some number of arguments, and those arguments will have at
        least one non-void thing. So in the rho we will have something like:

          x :-> MultiVal [xu1, xu2]

        Now, after we eliminate void binders in the pattern, we get exactly the same
        number of binders, and extend rho again with these:

          x1 :-> UnaryVal xu1
          x2 :-> MultiVal [] -- x2 is void
          x3 :-> UnaryVal xu2

        Now when we see x2 in a function argument position or in return position, we
        generate void#. In constructor argument position, we just remove it.

    So in short, when we have a void id,

      - We keep it if it's a lambda argument binder or
                           in argument position of an application.

      - We remove it if it's a DataCon field binder or
                             in argument position of a DataCon application.
    -}

    unariseArgBinder
        :: Bool -- data con arg?
        -> UnariseEnv -> Id -> UniqSM (UnariseEnv, [Id])
    unariseArgBinder :: Bool -> UnariseEnv -> Id -> UniqSM (UnariseEnv, [Id])
    unariseArgBinder Bool
    is_con_arg UnariseEnv
    rho Id
    x =
      case HasDebugCallStack => Type -> [PrimRep]
    Type -> [PrimRep]
    typePrimRep (Id -> Type
    idType Id
    x) of
        []
          | Bool
    is_con_arg
          -> (UnariseEnv, [Id]) -> UniqSM (UnariseEnv, [Id])
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (UnariseEnv -> Id -> UnariseVal -> UnariseEnv
    extendRho UnariseEnv
    rho Id
    x ([StgArg] -> UnariseVal
    MultiVal []), [])
          | Bool
    otherwise -- fun arg, do not remove void binders
          -> (UnariseEnv, [Id]) -> UniqSM (UnariseEnv, [Id])
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (UnariseEnv -> Id -> UnariseVal -> UnariseEnv
    extendRho UnariseEnv
    rho Id
    x ([StgArg] -> UnariseVal
    MultiVal []), [Id
    voidArgId])

        [PrimRep
    rep]
          -- Arg represented as single variable, but original type may still be an
          -- unboxed sum/tuple, e.g. (# Void# | Void# #).
          --
          -- While not unarising the binder in this case does not break any programs
          -- (because it unarises to a single variable), it triggers StgLint as we
          -- break the post-unarisation invariant that says unboxed tuple/sum
          -- binders should vanish. See Note [Post-unarisation invariants].
          | Type -> Bool
    isUnboxedSumType (Id -> Type
    idType Id
    x) Bool -> Bool -> Bool
    || Type -> Bool
    isUnboxedTupleType (Id -> Type
    idType Id
    x)
          -> do x' <- FastString -> Type -> UniqSM Id
    mkId (String -> FastString
    mkFastString String
    "us") (PrimRep -> Type
    primRepToType PrimRep
    rep)
                return (extendRho rho x (MultiVal [StgVarArg x']), [x'])
          | Bool
    otherwise
          -> (UnariseEnv, [Id]) -> UniqSM (UnariseEnv, [Id])
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (UnariseEnv -> Id -> UnariseEnv
    extendRhoWithoutValue UnariseEnv
    rho Id
    x, [Id
    x])

        [PrimRep]
    reps -> do
          xs <- FastString -> [Type] -> UniqSM [Id]
    mkIds (String -> FastString
    mkFastString String
    "us") ((PrimRep -> Type) -> [PrimRep] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map PrimRep -> Type
    primRepToType [PrimRep]
    reps)
          return (extendRho rho x (MultiVal (map StgVarArg xs)), xs)

    --------------------------------------------------------------------------------

    -- | MultiVal a function argument. Never returns an empty list.
    unariseFunArg :: UnariseEnv -> StgArg -> [StgArg]
    unariseFunArg :: UnariseEnv -> StgArg -> [StgArg]
    unariseFunArg UnariseEnv
    rho (StgVarArg Id
    x) =
      case UnariseEnv -> Id -> Maybe UnariseVal
    lookupRho UnariseEnv
    rho Id
    x of
        Just (MultiVal [])  -> [StgArg
    voidArg]   -- NB: do not remove void args
        Just (MultiVal [StgArg]
    as)  -> [StgArg]
    as
        Just (UnaryVal StgArg
    arg) -> [StgArg
    arg]
        Maybe UnariseVal
    Nothing             -> [Id -> StgArg
    StgVarArg Id
    x]
    unariseFunArg UnariseEnv
    _ arg :: StgArg
    arg@(StgLitArg Literal
    lit) = case Literal -> Maybe [StgArg]
    unariseLiteral_maybe Literal
    lit of
      -- forgetting to unariseLiteral_maybe here caused #23914
      Just [] -> [StgArg
    voidArg]
      Just [StgArg]
    as -> [StgArg]
    as
      Maybe [StgArg]
    Nothing -> [StgArg
    arg]

    unariseFunArgs :: UnariseEnv -> [StgArg] -> [StgArg]
    unariseFunArgs :: UnariseEnv -> [StgArg] -> [StgArg]
    unariseFunArgs = (StgArg -> [StgArg]) -> [StgArg] -> [StgArg]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ((StgArg -> [StgArg]) -> [StgArg] -> [StgArg])
    -> (UnariseEnv -> StgArg -> [StgArg])
    -> UnariseEnv
    -> [StgArg]
    -> [StgArg]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . UnariseEnv -> StgArg -> [StgArg]
    unariseFunArg

    unariseFunArgBinders :: UnariseEnv -> [Id] -> UniqSM (UnariseEnv, [Id])
    unariseFunArgBinders :: UnariseEnv -> [Id] -> UniqSM (UnariseEnv, [Id])
    unariseFunArgBinders UnariseEnv
    rho [Id]
    xs = ([[Id]] -> [Id]) -> (UnariseEnv, [[Id]]) -> (UnariseEnv, [Id])
    forall b c a. (b -> c) -> (a, b) -> (a, c)
    forall (p :: * -> * -> *) b c a.
    Bifunctor p =>
    (b -> c) -> p a b -> p a c
    second [[Id]] -> [Id]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ((UnariseEnv, [[Id]]) -> (UnariseEnv, [Id]))
    -> UniqSM (UnariseEnv, [[Id]]) -> UniqSM (UnariseEnv, [Id])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (UnariseEnv -> Id -> UniqSM (UnariseEnv, [Id]))
    -> UnariseEnv -> [Id] -> UniqSM (UnariseEnv, [[Id]])
    forall (m :: * -> *) (t :: * -> *) acc x y.
    (Monad m, Traversable t) =>
    (acc -> x -> m (acc, y)) -> acc -> t x -> m (acc, t y)
    mapAccumLM UnariseEnv -> Id -> UniqSM (UnariseEnv, [Id])
    unariseFunArgBinder UnariseEnv
    rho [Id]
    xs

    -- Result list of binders is never empty
    unariseFunArgBinder :: UnariseEnv -> Id -> UniqSM (UnariseEnv, [Id])
    unariseFunArgBinder :: UnariseEnv -> Id -> UniqSM (UnariseEnv, [Id])
    unariseFunArgBinder = Bool -> UnariseEnv -> Id -> UniqSM (UnariseEnv, [Id])
    unariseArgBinder Bool
    False

    --------------------------------------------------------------------------------

    -- | MultiVal a DataCon argument. Returns an empty list when argument is void.
    unariseConArg :: UnariseEnv -> InStgArg -> [OutStgArg]
    unariseConArg :: UnariseEnv -> StgArg -> [StgArg]
    unariseConArg UnariseEnv
    rho (StgVarArg Id
    x) =
      case UnariseEnv -> Id -> Maybe UnariseVal
    lookupRho UnariseEnv
    rho Id
    x of
        Just (UnaryVal StgArg
    arg) -> [StgArg
    arg]
        Just (MultiVal [StgArg]
    as) -> [StgArg]
    as      -- 'as' can be empty
        Maybe UnariseVal
    Nothing
          | HasDebugCallStack => Type -> Bool
    Type -> Bool
    isZeroBitTy (Id -> Type
    idType Id
    x) -> [] -- e.g. C realWorld#
                                         -- Here realWorld# is not in the envt, but
                                         -- is a void, and so should be eliminated
          | Bool
    otherwise -> [Id -> StgArg
    StgVarArg Id
    x]
    unariseConArg UnariseEnv
    _ arg :: StgArg
    arg@(StgLitArg Literal
    lit)
      | Just [StgArg]
    as <- Literal -> Maybe [StgArg]
    unariseLiteral_maybe Literal
    lit
      = [StgArg]
    as
      | Bool
    otherwise
      = Bool -> [StgArg] -> [StgArg]
    forall a. HasCallStack => Bool -> a -> a
    assert ([PrimRep] -> Bool
    isNvUnaryRep (HasDebugCallStack => Type -> [PrimRep]
    Type -> [PrimRep]
    typePrimRep (Literal -> Type
    literalType Literal
    lit))) -- We have no non-rubbish non-unary literals
        [StgArg
    arg]

    unariseConArgs :: UnariseEnv -> [InStgArg] -> [OutStgArg]
    unariseConArgs :: UnariseEnv -> [StgArg] -> [StgArg]
    unariseConArgs = (StgArg -> [StgArg]) -> [StgArg] -> [StgArg]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ((StgArg -> [StgArg]) -> [StgArg] -> [StgArg])
    -> (UnariseEnv -> StgArg -> [StgArg])
    -> UnariseEnv
    -> [StgArg]
    -> [StgArg]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . UnariseEnv -> StgArg -> [StgArg]
    unariseConArg

    unariseConArgBinders :: UnariseEnv -> [Id] -> UniqSM (UnariseEnv, [Id])
    unariseConArgBinders :: UnariseEnv -> [Id] -> UniqSM (UnariseEnv, [Id])
    unariseConArgBinders UnariseEnv
    rho [Id]
    xs = ([[Id]] -> [Id]) -> (UnariseEnv, [[Id]]) -> (UnariseEnv, [Id])
    forall b c a. (b -> c) -> (a, b) -> (a, c)
    forall (p :: * -> * -> *) b c a.
    Bifunctor p =>
    (b -> c) -> p a b -> p a c
    second [[Id]] -> [Id]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ((UnariseEnv, [[Id]]) -> (UnariseEnv, [Id]))
    -> UniqSM (UnariseEnv, [[Id]]) -> UniqSM (UnariseEnv, [Id])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (UnariseEnv -> Id -> UniqSM (UnariseEnv, [Id]))
    -> UnariseEnv -> [Id] -> UniqSM (UnariseEnv, [[Id]])
    forall (m :: * -> *) (t :: * -> *) acc x y.
    (Monad m, Traversable t) =>
    (acc -> x -> m (acc, y)) -> acc -> t x -> m (acc, t y)
    mapAccumLM UnariseEnv -> Id -> UniqSM (UnariseEnv, [Id])
    unariseConArgBinder UnariseEnv
    rho [Id]
    xs

    -- Different from `unariseFunArgBinder`: result list of binders may be empty.
    -- See DataCon applications case in Note [Post-unarisation invariants].
    unariseConArgBinder :: UnariseEnv -> Id -> UniqSM (UnariseEnv, [Id])
    unariseConArgBinder :: UnariseEnv -> Id -> UniqSM (UnariseEnv, [Id])
    unariseConArgBinder = Bool -> UnariseEnv -> Id -> UniqSM (UnariseEnv, [Id])
    unariseArgBinder Bool
    True

    --------------------------------------------------------------------------------

    mkIds :: FastString -> [NvUnaryType] -> UniqSM [Id]
    mkIds :: FastString -> [Type] -> UniqSM [Id]
    mkIds FastString
    fs [Type]
    tys = FastString -> [Type] -> UniqSM [Id]
    forall (m :: * -> *).
    MonadUnique m =>
    FastString -> [Type] -> m [Id]
    mkUnarisedIds FastString
    fs [Type]
    tys

    mkId :: FastString -> NvUnaryType -> UniqSM Id
    mkId :: FastString -> Type -> UniqSM Id
    mkId FastString
    s Type
    t = FastString -> Type -> UniqSM Id
    forall (m :: * -> *). MonadUnique m => FastString -> Type -> m Id
    mkUnarisedId FastString
    s Type
    t

    isMultiValBndr :: Id -> Bool
    isMultiValBndr :: Id -> Bool
    isMultiValBndr Id
    id
      | [PrimRep
    _] <- HasDebugCallStack => Type -> [PrimRep]
    Type -> [PrimRep]
    typePrimRep (Id -> Type
    idType Id
    id)
      = Bool
    False
      | Bool
    otherwise
      = Bool
    True

    isUnboxedSumBndr :: Id -> Bool
    isUnboxedSumBndr :: Id -> Bool
    isUnboxedSumBndr = Type -> Bool
    isUnboxedSumType (Type -> Bool) -> (Id -> Type) -> Id -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Id -> Type
    idType

    isUnboxedTupleBndr :: Id -> Bool
    isUnboxedTupleBndr :: Id -> Bool
    isUnboxedTupleBndr = Type -> Bool
    isUnboxedTupleType (Type -> Bool) -> (Id -> Type) -> Id -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Id -> Type
    idType

    mkTuple :: [StgArg] -> StgExpr
    mkTuple :: [StgArg] -> GenStgExpr 'Vanilla
    mkTuple [StgArg]
    args = DataCon
    -> ConstructorNumber
    -> [StgArg]
    -> [[PrimRep]]
    -> GenStgExpr 'Vanilla
    forall (pass :: StgPass).
    DataCon
    -> ConstructorNumber -> [StgArg] -> [[PrimRep]] -> GenStgExpr pass
    StgConApp (Boxity -> Int -> DataCon
    tupleDataCon Boxity
    Unboxed ([StgArg] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [StgArg]
    args)) ConstructorNumber
    NoNumber [StgArg]
    args []

    tagAltTy :: AltType
    tagAltTy :: AltType
    tagAltTy = PrimRep -> AltType
    PrimAlt PrimRep
    IntRep

    tagTy :: Type
    tagTy :: Type
    tagTy = Type
    intPrimTy

    voidArg :: StgArg
    voidArg :: StgArg
    voidArg = Id -> StgArg
    StgVarArg Id
    voidPrimId

    mkDefaultLitAlt :: [StgAlt] -> [StgAlt]
    -- We have an exhaustive list of literal alternatives
    --    1# -> e1
    --    2# -> e2
    -- Since they are exhaustive, we can replace one with DEFAULT, to avoid
    -- generating a final test. Remember, the DEFAULT comes first if it exists.
    mkDefaultLitAlt :: [GenStgAlt 'Vanilla] -> [GenStgAlt 'Vanilla]
    mkDefaultLitAlt [] = String -> SDoc -> [GenStgAlt 'Vanilla]
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "elimUbxSumExpr.mkDefaultAlt" (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Empty alts")
    mkDefaultLitAlt alts :: [GenStgAlt 'Vanilla]
    alts@(GenStgAlt{alt_con :: forall (pass :: StgPass). GenStgAlt pass -> AltCon
    alt_con=AltCon
    DEFAULT,alt_bndrs :: forall (pass :: StgPass). GenStgAlt pass -> [BinderP pass]
    alt_bndrs=[BinderP 'Vanilla]
    _,alt_rhs :: forall (pass :: StgPass). GenStgAlt pass -> GenStgExpr pass
    alt_rhs=GenStgExpr 'Vanilla
    _} : [GenStgAlt 'Vanilla]
    _)   = [GenStgAlt 'Vanilla]
    alts
    mkDefaultLitAlt (alt :: GenStgAlt 'Vanilla
    alt@GenStgAlt{alt_con :: forall (pass :: StgPass). GenStgAlt pass -> AltCon
    alt_con=LitAlt{}, alt_bndrs :: forall (pass :: StgPass). GenStgAlt pass -> [BinderP pass]
    alt_bndrs=[]} : [GenStgAlt 'Vanilla]
    alts) = GenStgAlt 'Vanilla
    alt {alt_con = DEFAULT} GenStgAlt 'Vanilla -> [GenStgAlt 'Vanilla] -> [GenStgAlt 'Vanilla]
    forall a. a -> [a] -> [a]
    : [GenStgAlt 'Vanilla]
    alts
    mkDefaultLitAlt [GenStgAlt 'Vanilla]
    alts = String -> SDoc -> [GenStgAlt 'Vanilla]
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "mkDefaultLitAlt" (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Not a lit alt:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [GenStgAlt 'Vanilla] -> SDoc
    forall (pass :: StgPass).
    OutputablePass pass =>
    [GenStgAlt pass] -> SDoc
    pprPanicAlts [GenStgAlt 'Vanilla]
    alts)

    pprPanicAlts :: OutputablePass pass => [GenStgAlt pass] -> SDoc
    pprPanicAlts :: forall (pass :: StgPass).
    OutputablePass pass =>
    [GenStgAlt pass] -> SDoc
    pprPanicAlts [GenStgAlt pass]
    alts = [SDoc] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ((GenStgAlt pass -> SDoc) -> [GenStgAlt pass] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map GenStgAlt pass -> SDoc
    forall (pass :: StgPass).
    OutputablePass pass =>
    GenStgAlt pass -> SDoc
    pprPanicAlt [GenStgAlt pass]
    alts)

    pprPanicAlt :: OutputablePass pass => GenStgAlt pass -> SDoc
    pprPanicAlt :: forall (pass :: StgPass).
    OutputablePass pass =>
    GenStgAlt pass -> SDoc
    pprPanicAlt GenStgAlt{alt_con :: forall (pass :: StgPass). GenStgAlt pass -> AltCon
    alt_con=AltCon
    c,alt_bndrs :: forall (pass :: StgPass). GenStgAlt pass -> [BinderP pass]
    alt_bndrs=[BinderP pass]
    b,alt_rhs :: forall (pass :: StgPass). GenStgAlt pass -> GenStgExpr pass
    alt_rhs=GenStgExpr pass
    e} = (AltCon, [BinderP pass], SDoc) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (AltCon
    c,[BinderP pass]
    b,StgPprOpts -> GenStgExpr pass -> SDoc
    forall (pass :: StgPass).
    OutputablePass pass =>
    StgPprOpts -> GenStgExpr pass -> SDoc
    pprStgExpr StgPprOpts
    panicStgPprOpts GenStgExpr pass
    e)