    {-# LANGUAGE LambdaCase #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  GHC.StgToJS.Args
    -- Copyright   :  (c) The University of Glasgow 2001
    -- License     :  BSD-style (see the file LICENSE)
    --
    -- Maintainer  :  Jeffrey Young  <jeffrey.young@iohk.io>
    --                Luite Stegeman <luite.stegeman@iohk.io>
    --                Sylvain Henry  <sylvain.henry@iohk.io>
    --                Josh Meredith  <josh.meredith@iohk.io>
    -- Stability   :  experimental
    --
    --  Code generation of application arguments
    -----------------------------------------------------------------------------

    module GHC.StgToJS.Arg
      ( genArg
      , genIdArg
      , genIdArgI
      , genIdStackArgI
      , allocConStatic
      , allocUnboxedConStatic
      , allocateStaticList
      , jsStaticArg
      , jsStaticArgs
      )
    where

    import GHC.Prelude

    import GHC.JS.Syntax
    import GHC.JS.Make

    import GHC.StgToJS.DataCon
    import GHC.StgToJS.Types
    import GHC.StgToJS.Monad
    import GHC.StgToJS.Literal
    import GHC.StgToJS.CoreUtils
    import GHC.StgToJS.Profiling
    import GHC.StgToJS.Ids

    import GHC.Builtin.Types
    import GHC.Stg.Syntax
    import GHC.Core.DataCon

    import GHC.Types.CostCentre
    import GHC.Types.Unique.FM
    import GHC.Types.Id

    import GHC.Utils.Misc
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import qualified Control.Monad.Trans.State.Strict as State

    {-
    Note [ Unboxable Literals Optimization ]
    ~~~~~~~~~~~~~~~~~~

    Boxable types in the JS backend are represented as heap objects. See Note
    [StgToJS design] in GHC.StgToJS.hs for more details. Some types, such as Int8
    do not benefit from not being wrapped in an object in the JS runtime. This optimization
    detects such types and changes the code generator to generate a more efficient
    representation. The change is minor and saves one level on indirection. Instead
    of generating a wrapper object with a field for the value's payload, such as:

    // a JS object for an Int8
    var anInt8 = { d1 = <Int8# payload>
                 , f  : entry function which would scrutinize the payload
                 }

    we instead generate:

    // notice, no wrapper object. This representation is essentially an Int8# in the JS backend
    var anInt8 = <Int8# payload>

    This optimization fires when the follow invariants hold:
      1. The value in question has a Type which has a single data constructor
      2. The data constructor holds a single field that is monomorphic
      3. The value in question is distinguishable from a THUNK using the JavaScript typeof operator.

    From the haskell perspective this means that:
      1. An Int8# is always a JavaScript 'number', never a JavaScript object.
      2. An Int8 is either a JavaScript 'number' _or_ a JavaScript object depending on
         its use case and this optimization.

    How is this sound?
    ~~~~~~~~~~~~~~~~~~

    Normally this optimization would violate the guarantees of call-by-need, however
    we are able to statically detect whether the type in question will be a THUNK or
    not during code gen because the JS backend is consuming STG and we can check
    during runtime with the typeof operator. Similarly we can check at runtime using
    JavaScript's introspection operator `typeof`. Thus, when we know the value in
    question will not be a THUNK we can safely elide the wrapping object, which
    unboxes the value in the JS runtime. For example, an Int8 contains an Int8#
    which has the JavaScript type 'number'. A THUNK of type Int8 would have a
    JavaScript type 'object', so using 'typeof' allows us to check if we have
    something that is definitely evaluated (i.e., a 'number') or something else. If
    it is an 'object' then we may need to enter it to begin its evaluation. Consider
    a type which has a 'ThreadId#' field; such as type would not be subject to this
    optimization because it has to be represented as a JavaScript 'object' and thus
    cannot be unboxed in this way. Another (edge) case is Int64#. Int64# is
    similarly not unboxable in this way because Int64# does not fit in one
    JavaScript variable and thus requires an 'object' for its representation in the
    JavaScript runtime.

    -}

    -- | Generate JS code for static arguments
    genStaticArg :: HasDebugCallStack => StgArg -> G [StaticArg]
    genStaticArg :: (() :: Constraint) => StgArg -> G [StaticArg]
    genStaticArg StgArg
    a = case StgArg
    a of
      StgLitArg Literal
    l -> (StaticLit -> StaticArg) -> [StaticLit] -> [StaticArg]
    forall a b. (a -> b) -> [a] -> [b]
    map StaticLit -> StaticArg
    StaticLitArg ([StaticLit] -> [StaticArg])
    -> StateT GenState IO [StaticLit] -> G [StaticArg]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Literal -> StateT GenState IO [StaticLit]
    genStaticLit Literal
    l
      StgVarArg Id
    i -> do
        UniqFM Id CgStgExpr
    unFloat <- (GenState -> UniqFM Id CgStgExpr)
    -> StateT GenState IO (UniqFM Id CgStgExpr)
    forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
    State.gets GenState -> UniqFM Id CgStgExpr
    gsUnfloated
        case UniqFM Id CgStgExpr -> Id -> Maybe CgStgExpr
    forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
    lookupUFM UniqFM Id CgStgExpr
    unFloat Id
    i of
          Maybe CgStgExpr
    Nothing -> G [StaticArg]
    reg
          Just CgStgExpr
    expr -> CgStgExpr -> G [StaticArg]
    unfloated CgStgExpr
    expr
         where
           r :: VarType
    r = (() :: Constraint) => UnaryType -> VarType
    UnaryType -> VarType
    uTypeVt (UnaryType -> VarType)
    -> (StgArg -> UnaryType) -> StgArg -> VarType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StgArg -> UnaryType
    stgArgType (StgArg -> VarType) -> StgArg -> VarType
    forall a b. (a -> b) -> a -> b
    $ StgArg
    a
           reg :: G [StaticArg]
    reg
             | VarType -> Bool
    isVoid VarType
    r            =
                 [StaticArg] -> G [StaticArg]
    forall a. a -> StateT GenState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
             | Id
    i Id -> Id -> Bool
    forall a. Eq a => a -> a -> Bool
    == Id
    trueDataConId  =
                 [StaticArg] -> G [StaticArg]
    forall a. a -> StateT GenState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [StaticLit -> StaticArg
    StaticLitArg (Bool -> StaticLit
    BoolLit Bool
    True)]
             | Id
    i Id -> Id -> Bool
    forall a. Eq a => a -> a -> Bool
    == Id
    falseDataConId =
                 [StaticArg] -> G [StaticArg]
    forall a. a -> StateT GenState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [StaticLit -> StaticArg
    StaticLitArg (Bool -> StaticLit
    BoolLit Bool
    False)]
             | VarType -> Bool
    isMultiVar VarType
    r        =
                 (Ident -> StaticArg) -> [Ident] -> [StaticArg]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(TxtI FastString
    t) -> FastString -> StaticArg
    StaticObjArg FastString
    t) ([Ident] -> [StaticArg])
    -> StateT GenState IO [Ident] -> G [StaticArg]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ConTag -> StateT GenState IO Ident)
    -> [ConTag] -> StateT GenState IO [Ident]
    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 -> ConTag -> StateT GenState IO Ident
    identForIdN Id
    i) [ConTag
    1..VarType -> ConTag
    varSize VarType
    r] -- this seems wrong, not an obj?
             | Bool
    otherwise           = (\(TxtI FastString
    it) -> [FastString -> StaticArg
    StaticObjArg FastString
    it]) (Ident -> [StaticArg]) -> StateT GenState IO Ident -> G [StaticArg]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Id -> StateT GenState IO Ident
    identForId Id
    i

           unfloated :: CgStgExpr -> G [StaticArg]
           unfloated :: CgStgExpr -> G [StaticArg]
    unfloated (StgLit Literal
    l) = (StaticLit -> StaticArg) -> [StaticLit] -> [StaticArg]
    forall a b. (a -> b) -> [a] -> [b]
    map StaticLit -> StaticArg
    StaticLitArg ([StaticLit] -> [StaticArg])
    -> StateT GenState IO [StaticLit] -> G [StaticArg]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Literal -> StateT GenState IO [StaticLit]
    genStaticLit Literal
    l
           unfloated (StgConApp DataCon
    dc ConstructorNumber
    _n [StgArg]
    args [UnaryType]
    _)
             | DataCon -> Bool
    isBoolDataCon DataCon
    dc Bool -> Bool -> Bool
    || DataCon -> Bool
    isUnboxableCon DataCon
    dc =
                 (StaticArg -> [StaticArg] -> [StaticArg]
    forall a. a -> [a] -> [a]
    :[]) (StaticArg -> [StaticArg])
    -> ([[StaticArg]] -> StaticArg) -> [[StaticArg]] -> [StaticArg]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DataCon -> [StaticArg] -> StaticArg
    allocUnboxedConStatic DataCon
    dc ([StaticArg] -> StaticArg)
    -> ([[StaticArg]] -> [StaticArg]) -> [[StaticArg]] -> StaticArg
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[StaticArg]] -> [StaticArg]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[StaticArg]] -> [StaticArg])
    -> StateT GenState IO [[StaticArg]] -> G [StaticArg]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (StgArg -> G [StaticArg])
    -> [StgArg] -> StateT GenState IO [[StaticArg]]
    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 (() :: Constraint) => StgArg -> G [StaticArg]
    StgArg -> G [StaticArg]
    genStaticArg [StgArg]
    args -- fixme what is allocunboxedcon?
             | [StgArg] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [StgArg]
    args = (\(TxtI FastString
    t) -> [FastString -> StaticArg
    StaticObjArg FastString
    t]) (Ident -> [StaticArg]) -> StateT GenState IO Ident -> G [StaticArg]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Id -> StateT GenState IO Ident
    identForId (DataCon -> Id
    dataConWorkId DataCon
    dc)
             | Bool
    otherwise = do
                 [StaticArg]
    as       <- [[StaticArg]] -> [StaticArg]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[StaticArg]] -> [StaticArg])
    -> StateT GenState IO [[StaticArg]] -> G [StaticArg]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (StgArg -> G [StaticArg])
    -> [StgArg] -> StateT GenState IO [[StaticArg]]
    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 (() :: Constraint) => StgArg -> G [StaticArg]
    StgArg -> G [StaticArg]
    genStaticArg [StgArg]
    args
                 (TxtI FastString
    e) <- DataCon -> StateT GenState IO Ident
    identForDataConWorker DataCon
    dc
                 [StaticArg] -> G [StaticArg]
    forall a. a -> StateT GenState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [FastString -> [StaticArg] -> StaticArg
    StaticConArg FastString
    e [StaticArg]
    as]
           unfloated CgStgExpr
    x = String -> SDoc -> G [StaticArg]
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "genArg: unexpected unfloated expression" (StgPprOpts -> CgStgExpr -> SDoc
    forall (pass :: StgPass).
    OutputablePass pass =>
    StgPprOpts -> GenStgExpr pass -> SDoc
    pprStgExpr StgPprOpts
    panicStgPprOpts CgStgExpr
    x)

    -- | Generate JS code for an StgArg
    genArg :: HasDebugCallStack => StgArg -> G [JExpr]
    genArg :: (() :: Constraint) => StgArg -> G [JExpr]
    genArg StgArg
    a = case StgArg
    a of
      StgLitArg Literal
    l -> (() :: Constraint) => Literal -> G [JExpr]
    Literal -> G [JExpr]
    genLit Literal
    l
      StgVarArg Id
    i -> do
        UniqFM Id CgStgExpr
    unFloat <- (GenState -> UniqFM Id CgStgExpr)
    -> StateT GenState IO (UniqFM Id CgStgExpr)
    forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
    State.gets GenState -> UniqFM Id CgStgExpr
    gsUnfloated
        case UniqFM Id CgStgExpr -> Id -> Maybe CgStgExpr
    forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
    lookupUFM UniqFM Id CgStgExpr
    unFloat Id
    i of
          Just CgStgExpr
    expr -> (() :: Constraint) => CgStgExpr -> G [JExpr]
    CgStgExpr -> G [JExpr]
    unfloated CgStgExpr
    expr
          Maybe CgStgExpr
    Nothing
           | VarType -> Bool
    isVoid VarType
    (() :: Constraint) => VarType
    r            -> [JExpr] -> G [JExpr]
    forall a. a -> StateT GenState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
           | Id
    i Id -> Id -> Bool
    forall a. Eq a => a -> a -> Bool
    == Id
    trueDataConId  -> [JExpr] -> G [JExpr]
    forall a. a -> StateT GenState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [JExpr
    true_]
           | Id
    i Id -> Id -> Bool
    forall a. Eq a => a -> a -> Bool
    == Id
    falseDataConId -> [JExpr] -> G [JExpr]
    forall a. a -> StateT GenState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [JExpr
    false_]
           | VarType -> Bool
    isMultiVar VarType
    (() :: Constraint) => VarType
    r        -> (ConTag -> StateT GenState IO JExpr) -> [ConTag] -> G [JExpr]
    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 -> ConTag -> StateT GenState IO JExpr
    varForIdN Id
    i) [ConTag
    1..VarType -> ConTag
    varSize VarType
    (() :: Constraint) => VarType
    r]
           | Bool
    otherwise           -> (JExpr -> [JExpr] -> [JExpr]
    forall a. a -> [a] -> [a]
    :[]) (JExpr -> [JExpr]) -> StateT GenState IO JExpr -> G [JExpr]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Id -> StateT GenState IO JExpr
    varForId Id
    i

       where
         -- if our argument is a joinid, it can be an unboxed tuple
         r :: HasDebugCallStack => VarType
         r :: (() :: Constraint) => VarType
    r = (() :: Constraint) => UnaryType -> VarType
    UnaryType -> VarType
    uTypeVt (UnaryType -> VarType)
    -> (StgArg -> UnaryType) -> StgArg -> VarType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StgArg -> UnaryType
    stgArgType (StgArg -> VarType) -> StgArg -> VarType
    forall a b. (a -> b) -> a -> b
    $ StgArg
    a

         unfloated :: HasDebugCallStack => CgStgExpr -> G [JExpr]
         unfloated :: (() :: Constraint) => CgStgExpr -> G [JExpr]
    unfloated = \case
          StgLit Literal
    l -> (() :: Constraint) => Literal -> G [JExpr]
    Literal -> G [JExpr]
    genLit Literal
    l
          StgConApp DataCon
    dc ConstructorNumber
    _n [StgArg]
    args [UnaryType]
    _
           | DataCon -> Bool
    isBoolDataCon DataCon
    dc Bool -> Bool -> Bool
    || DataCon -> Bool
    isUnboxableCon DataCon
    dc
           -> (JExpr -> [JExpr] -> [JExpr]
    forall a. a -> [a] -> [a]
    :[]) (JExpr -> [JExpr]) -> ([[JExpr]] -> JExpr) -> [[JExpr]] -> [JExpr]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DataCon -> [JExpr] -> JExpr
    allocUnboxedCon DataCon
    dc ([JExpr] -> JExpr) -> ([[JExpr]] -> [JExpr]) -> [[JExpr]] -> JExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[JExpr]] -> [JExpr]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[JExpr]] -> [JExpr]) -> StateT GenState IO [[JExpr]] -> G [JExpr]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (StgArg -> G [JExpr]) -> [StgArg] -> StateT GenState IO [[JExpr]]
    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 (() :: Constraint) => StgArg -> G [JExpr]
    StgArg -> G [JExpr]
    genArg [StgArg]
    args
           | [StgArg] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [StgArg]
    args -> (JExpr -> [JExpr] -> [JExpr]
    forall a. a -> [a] -> [a]
    :[]) (JExpr -> [JExpr]) -> StateT GenState IO JExpr -> G [JExpr]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Id -> StateT GenState IO JExpr
    varForId (DataCon -> Id
    dataConWorkId DataCon
    dc)
           | Bool
    otherwise -> do
               [JExpr]
    as <- [[JExpr]] -> [JExpr]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[JExpr]] -> [JExpr]) -> StateT GenState IO [[JExpr]] -> G [JExpr]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (StgArg -> G [JExpr]) -> [StgArg] -> StateT GenState IO [[JExpr]]
    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 (() :: Constraint) => StgArg -> G [JExpr]
    StgArg -> G [JExpr]
    genArg [StgArg]
    args
               JExpr
    e  <- DataCon -> StateT GenState IO JExpr
    varForDataConWorker DataCon
    dc
               Bool
    inl_alloc <- StgToJSConfig -> Bool
    csInlineAlloc (StgToJSConfig -> Bool)
    -> StateT GenState IO StgToJSConfig -> StateT GenState IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> StateT GenState IO StgToJSConfig
    getSettings
               [JExpr] -> G [JExpr]
    forall a. a -> StateT GenState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Bool -> JExpr -> [JExpr] -> Maybe JExpr -> JExpr
    allocDynamicE Bool
    inl_alloc JExpr
    e [JExpr]
    as Maybe JExpr
    forall a. Maybe a
    Nothing]
          CgStgExpr
    x -> String -> SDoc -> G [JExpr]
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "genArg: unexpected unfloated expression" (StgPprOpts -> CgStgExpr -> SDoc
    forall (pass :: StgPass).
    OutputablePass pass =>
    StgPprOpts -> GenStgExpr pass -> SDoc
    pprStgExpr StgPprOpts
    panicStgPprOpts CgStgExpr
    x)

    -- | Generate a Var as JExpr
    genIdArg :: HasDebugCallStack => Id -> G [JExpr]
    genIdArg :: (() :: Constraint) => Id -> G [JExpr]
    genIdArg Id
    i = (() :: Constraint) => StgArg -> G [JExpr]
    StgArg -> G [JExpr]
    genArg (Id -> StgArg
    StgVarArg Id
    i)

    -- | Generate an Id as an Ident
    genIdArgI :: HasDebugCallStack => Id -> G [Ident]
    genIdArgI :: (() :: Constraint) => Id -> StateT GenState IO [Ident]
    genIdArgI Id
    i
      | VarType -> Bool
    isVoid VarType
    r     = [Ident] -> StateT GenState IO [Ident]
    forall a. a -> StateT GenState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
      | VarType -> Bool
    isMultiVar VarType
    r = (ConTag -> StateT GenState IO Ident)
    -> [ConTag] -> StateT GenState IO [Ident]
    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 -> ConTag -> StateT GenState IO Ident
    identForIdN Id
    i) [ConTag
    1..VarType -> ConTag
    varSize VarType
    r]
      | Bool
    otherwise    = (Ident -> [Ident] -> [Ident]
    forall a. a -> [a] -> [a]
    :[]) (Ident -> [Ident])
    -> StateT GenState IO Ident -> StateT GenState IO [Ident]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Id -> StateT GenState IO Ident
    identForId Id
    i
      where
        r :: VarType
    r = (() :: Constraint) => UnaryType -> VarType
    UnaryType -> VarType
    uTypeVt (UnaryType -> VarType) -> (Id -> UnaryType) -> Id -> VarType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Id -> UnaryType
    idType (Id -> VarType) -> Id -> VarType
    forall a b. (a -> b) -> a -> b
    $ Id
    i

    -- | Generate IDs for stack arguments. See 'StgToJS.Expr.loadRetArgs' for use case
    genIdStackArgI :: HasDebugCallStack => Id -> G [(Ident,StackSlot)]
    genIdStackArgI :: (() :: Constraint) => Id -> G [(Ident, StackSlot)]
    genIdStackArgI Id
    i = (ConTag -> Ident -> (Ident, StackSlot))
    -> [ConTag] -> [Ident] -> [(Ident, StackSlot)]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith ConTag -> Ident -> (Ident, StackSlot)
    f [ConTag
    1..] ([Ident] -> [(Ident, StackSlot)])
    -> StateT GenState IO [Ident] -> G [(Ident, StackSlot)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (() :: Constraint) => Id -> StateT GenState IO [Ident]
    Id -> StateT GenState IO [Ident]
    genIdArgI Id
    i
      where
        f :: Int -> Ident -> (Ident,StackSlot)
        f :: ConTag -> Ident -> (Ident, StackSlot)
    f ConTag
    n Ident
    ident = (Ident
    ident, Id -> ConTag -> StackSlot
    SlotId Id
    i ConTag
    n)

    -- | Allocate Static Constructors
    allocConStatic :: HasDebugCallStack => Ident -> CostCentreStack -> DataCon -> [StgArg] -> G ()
    allocConStatic :: (() :: Constraint) =>
    Ident -> CostCentreStack -> DataCon -> [StgArg] -> G ()
    allocConStatic (TxtI FastString
    to) CostCentreStack
    cc DataCon
    con [StgArg]
    args = do
      [[StaticArg]]
    as <- (StgArg -> G [StaticArg])
    -> [StgArg] -> StateT GenState IO [[StaticArg]]
    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 (() :: Constraint) => StgArg -> G [StaticArg]
    StgArg -> G [StaticArg]
    genStaticArg [StgArg]
    args
      Maybe Ident
    cc' <- CostCentreStack -> G (Maybe Ident)
    costCentreStackLbl CostCentreStack
    cc
      Maybe Ident -> [StaticArg] -> G ()
    (() :: Constraint) => Maybe Ident -> [StaticArg] -> G ()
    allocConStatic' Maybe Ident
    cc' ([[StaticArg]] -> [StaticArg]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[StaticArg]]
    as)
      where
        -- see Note [ Unboxable Literals Optimization ] for the purpose of these
        -- checks
        allocConStatic' :: HasDebugCallStack => Maybe Ident -> [StaticArg] -> G ()
        allocConStatic' :: (() :: Constraint) => Maybe Ident -> [StaticArg] -> G ()
    allocConStatic' Maybe Ident
    cc' []
          | DataCon -> Bool
    isBoolDataCon DataCon
    con Bool -> Bool -> Bool
    && DataCon -> ConTag
    dataConTag DataCon
    con ConTag -> ConTag -> Bool
    forall a. Eq a => a -> a -> Bool
    == ConTag
    1 =
               FastString -> StaticVal -> Maybe Ident -> G ()
    emitStatic FastString
    to (StaticUnboxed -> StaticVal
    StaticUnboxed (StaticUnboxed -> StaticVal) -> StaticUnboxed -> StaticVal
    forall a b. (a -> b) -> a -> b
    $ Bool -> StaticUnboxed
    StaticUnboxedBool Bool
    False) Maybe Ident
    cc'
          | DataCon -> Bool
    isBoolDataCon DataCon
    con Bool -> Bool -> Bool
    && DataCon -> ConTag
    dataConTag DataCon
    con ConTag -> ConTag -> Bool
    forall a. Eq a => a -> a -> Bool
    == ConTag
    2 =
               FastString -> StaticVal -> Maybe Ident -> G ()
    emitStatic FastString
    to (StaticUnboxed -> StaticVal
    StaticUnboxed (StaticUnboxed -> StaticVal) -> StaticUnboxed -> StaticVal
    forall a b. (a -> b) -> a -> b
    $ Bool -> StaticUnboxed
    StaticUnboxedBool Bool
    True) Maybe Ident
    cc'
          | Bool
    otherwise = do
               (TxtI FastString
    e) <- DataCon -> StateT GenState IO Ident
    identForDataConWorker DataCon
    con
               FastString -> StaticVal -> Maybe Ident -> G ()
    emitStatic FastString
    to (FastString -> [StaticArg] -> StaticVal
    StaticData FastString
    e []) Maybe Ident
    cc'
        allocConStatic' Maybe Ident
    cc' [StaticArg
    x]
          | DataCon -> Bool
    isUnboxableCon DataCon
    con =
            case StaticArg
    x of
              StaticLitArg (IntLit Integer
    i)    ->
                FastString -> StaticVal -> Maybe Ident -> G ()
    emitStatic FastString
    to (StaticUnboxed -> StaticVal
    StaticUnboxed (StaticUnboxed -> StaticVal) -> StaticUnboxed -> StaticVal
    forall a b. (a -> b) -> a -> b
    $ Integer -> StaticUnboxed
    StaticUnboxedInt Integer
    i) Maybe Ident
    cc'
              StaticLitArg (BoolLit Bool
    b)   ->
                FastString -> StaticVal -> Maybe Ident -> G ()
    emitStatic FastString
    to (StaticUnboxed -> StaticVal
    StaticUnboxed (StaticUnboxed -> StaticVal) -> StaticUnboxed -> StaticVal
    forall a b. (a -> b) -> a -> b
    $ Bool -> StaticUnboxed
    StaticUnboxedBool Bool
    b) Maybe Ident
    cc'
              StaticLitArg (DoubleLit SaneDouble
    d) ->
                FastString -> StaticVal -> Maybe Ident -> G ()
    emitStatic FastString
    to (StaticUnboxed -> StaticVal
    StaticUnboxed (StaticUnboxed -> StaticVal) -> StaticUnboxed -> StaticVal
    forall a b. (a -> b) -> a -> b
    $ SaneDouble -> StaticUnboxed
    StaticUnboxedDouble SaneDouble
    d) Maybe Ident
    cc'
              StaticArg
    _                          ->
                String -> SDoc -> G ()
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "allocConStatic: invalid unboxed literal" (StaticArg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr StaticArg
    x)
        allocConStatic' Maybe Ident
    cc' [StaticArg]
    xs =
               if DataCon
    con DataCon -> DataCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == DataCon
    consDataCon
                  then case [StgArg]
    args of
                    (StgArg
    a0:StgArg
    a1:[StgArg]
    _) -> (StaticVal -> Maybe Ident -> G ())
    -> Maybe Ident -> StaticVal -> G ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (FastString -> StaticVal -> Maybe Ident -> G ()
    emitStatic FastString
    to) Maybe Ident
    cc' (StaticVal -> G ()) -> StateT GenState IO StaticVal -> G ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< [StgArg] -> StgArg -> StateT GenState IO StaticVal
    allocateStaticList [StgArg
    a0] StgArg
    a1
                    [StgArg]
    _         -> String -> G ()
    forall a. HasCallStack => String -> a
    panic String
    "allocConStatic: invalid args for consDataCon"
                  else do
                    (TxtI FastString
    e) <- DataCon -> StateT GenState IO Ident
    identForDataConWorker DataCon
    con
                    FastString -> StaticVal -> Maybe Ident -> G ()
    emitStatic FastString
    to (FastString -> [StaticArg] -> StaticVal
    StaticData FastString
    e [StaticArg]
    xs) Maybe Ident
    cc'

    -- | Allocate unboxed constructors
    allocUnboxedConStatic :: DataCon -> [StaticArg] -> StaticArg
    allocUnboxedConStatic :: DataCon -> [StaticArg] -> StaticArg
    allocUnboxedConStatic DataCon
    con = \case
      []
        | DataCon -> Bool
    isBoolDataCon DataCon
    con Bool -> Bool -> Bool
    && DataCon -> ConTag
    dataConTag DataCon
    con ConTag -> ConTag -> Bool
    forall a. Eq a => a -> a -> Bool
    == ConTag
    1
        -> StaticLit -> StaticArg
    StaticLitArg (Bool -> StaticLit
    BoolLit Bool
    False)
        | DataCon -> Bool
    isBoolDataCon DataCon
    con Bool -> Bool -> Bool
    && DataCon -> ConTag
    dataConTag DataCon
    con ConTag -> ConTag -> Bool
    forall a. Eq a => a -> a -> Bool
    == ConTag
    2
        -> StaticLit -> StaticArg
    StaticLitArg (Bool -> StaticLit
    BoolLit Bool
    True)
      [a :: StaticArg
    a@(StaticLitArg (IntLit Integer
    _i))]    -> StaticArg
    a
      [a :: StaticArg
    a@(StaticLitArg (DoubleLit SaneDouble
    _d))] -> StaticArg
    a
      [StaticArg]
    _ -> String -> SDoc -> StaticArg
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "allocUnboxedConStatic: not an unboxed constructor" (DataCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr DataCon
    con)

    -- | Allocate Static list
    allocateStaticList :: [StgArg] -> StgArg -> G StaticVal
    allocateStaticList :: [StgArg] -> StgArg -> StateT GenState IO StaticVal
    allocateStaticList [StgArg]
    xs a :: StgArg
    a@(StgVarArg Id
    i)
      | Id -> Maybe DataCon
    isDataConId_maybe Id
    i Maybe DataCon -> Maybe DataCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == DataCon -> Maybe DataCon
    forall a. a -> Maybe a
    Just DataCon
    nilDataCon = [StgArg] -> Maybe StgArg -> StateT GenState IO StaticVal
    listAlloc [StgArg]
    xs Maybe StgArg
    forall a. Maybe a
    Nothing
      | Bool
    otherwise = do
          UniqFM Id CgStgExpr
    unFloat <- (GenState -> UniqFM Id CgStgExpr)
    -> StateT GenState IO (UniqFM Id CgStgExpr)
    forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
    State.gets GenState -> UniqFM Id CgStgExpr
    gsUnfloated
          case UniqFM Id CgStgExpr -> Id -> Maybe CgStgExpr
    forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
    lookupUFM UniqFM Id CgStgExpr
    unFloat Id
    i of
            Just (StgConApp DataCon
    dc ConstructorNumber
    _n [StgArg
    h,StgArg
    t] [UnaryType]
    _)
              | DataCon
    dc DataCon -> DataCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == DataCon
    consDataCon -> [StgArg] -> StgArg -> StateT GenState IO StaticVal
    allocateStaticList (StgArg
    hStgArg -> [StgArg] -> [StgArg]
    forall a. a -> [a] -> [a]
    :[StgArg]
    xs) StgArg
    t
            Maybe CgStgExpr
    _ -> [StgArg] -> Maybe StgArg -> StateT GenState IO StaticVal
    listAlloc [StgArg]
    xs (StgArg -> Maybe StgArg
    forall a. a -> Maybe a
    Just StgArg
    a)
      where
        listAlloc :: [StgArg] -> Maybe StgArg -> G StaticVal
        listAlloc :: [StgArg] -> Maybe StgArg -> StateT GenState IO StaticVal
    listAlloc [StgArg]
    xs Maybe StgArg
    Nothing  = do
          [StaticArg]
    as <- [[StaticArg]] -> [StaticArg]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[StaticArg]] -> [StaticArg])
    -> ([[StaticArg]] -> [[StaticArg]]) -> [[StaticArg]] -> [StaticArg]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[StaticArg]] -> [[StaticArg]]
    forall a. [a] -> [a]
    reverse ([[StaticArg]] -> [StaticArg])
    -> StateT GenState IO [[StaticArg]] -> G [StaticArg]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (StgArg -> G [StaticArg])
    -> [StgArg] -> StateT GenState IO [[StaticArg]]
    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 (() :: Constraint) => StgArg -> G [StaticArg]
    StgArg -> G [StaticArg]
    genStaticArg [StgArg]
    xs
          StaticVal -> StateT GenState IO StaticVal
    forall a. a -> StateT GenState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([StaticArg] -> Maybe FastString -> StaticVal
    StaticList [StaticArg]
    as Maybe FastString
    forall a. Maybe a
    Nothing)
        listAlloc [StgArg]
    xs (Just StgArg
    r) = do
          [StaticArg]
    as <- [[StaticArg]] -> [StaticArg]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[StaticArg]] -> [StaticArg])
    -> ([[StaticArg]] -> [[StaticArg]]) -> [[StaticArg]] -> [StaticArg]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[StaticArg]] -> [[StaticArg]]
    forall a. [a] -> [a]
    reverse ([[StaticArg]] -> [StaticArg])
    -> StateT GenState IO [[StaticArg]] -> G [StaticArg]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (StgArg -> G [StaticArg])
    -> [StgArg] -> StateT GenState IO [[StaticArg]]
    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 (() :: Constraint) => StgArg -> G [StaticArg]
    StgArg -> G [StaticArg]
    genStaticArg [StgArg]
    xs
          [StaticArg]
    r' <- (() :: Constraint) => StgArg -> G [StaticArg]
    StgArg -> G [StaticArg]
    genStaticArg StgArg
    r
          case [StaticArg]
    r' of
            [StaticObjArg FastString
    ri] -> StaticVal -> StateT GenState IO StaticVal
    forall a. a -> StateT GenState IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([StaticArg] -> Maybe FastString -> StaticVal
    StaticList [StaticArg]
    as (FastString -> Maybe FastString
    forall a. a -> Maybe a
    Just FastString
    ri))
            [StaticArg]
    _                 ->
              String -> SDoc -> StateT GenState IO StaticVal
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "allocateStaticList: invalid argument (tail)" (([StgArg], StgArg) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ([StgArg]
    xs, StgArg
    r))
    allocateStaticList [StgArg]
    _ StgArg
    _ = String -> StateT GenState IO StaticVal
    forall a. HasCallStack => String -> a
    panic String
    "allocateStaticList: unexpected literal in list"

    -- | Generate JS code corresponding to a static arg
    jsStaticArg :: StaticArg -> JExpr
    jsStaticArg :: StaticArg -> JExpr
    jsStaticArg = \case
      StaticLitArg StaticLit
    l      -> StaticLit -> JExpr
    forall a. ToJExpr a => a -> JExpr
    toJExpr StaticLit
    l
      StaticObjArg FastString
    t      -> JVal -> JExpr
    ValExpr (Ident -> JVal
    JVar (FastString -> Ident
    TxtI FastString
    t))
      StaticConArg FastString
    c [StaticArg]
    args ->
        Bool -> JExpr -> [JExpr] -> Maybe JExpr -> JExpr
    allocDynamicE Bool
    False (JVal -> JExpr
    ValExpr (JVal -> JExpr) -> (FastString -> JVal) -> FastString -> JExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ident -> JVal
    JVar (Ident -> JVal) -> (FastString -> Ident) -> FastString -> JVal
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FastString -> Ident
    TxtI (FastString -> JExpr) -> FastString -> JExpr
    forall a b. (a -> b) -> a -> b
    $ FastString
    c) ((StaticArg -> JExpr) -> [StaticArg] -> [JExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map StaticArg -> JExpr
    jsStaticArg [StaticArg]
    args) Maybe JExpr
    forall a. Maybe a
    Nothing

    -- | Generate JS code corresponding to a list of static args
    jsStaticArgs :: [StaticArg] -> JExpr
    jsStaticArgs :: [StaticArg] -> JExpr
    jsStaticArgs = JVal -> JExpr
    ValExpr (JVal -> JExpr) -> ([StaticArg] -> JVal) -> [StaticArg] -> JExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [JExpr] -> JVal
    JList ([JExpr] -> JVal)
    -> ([StaticArg] -> [JExpr]) -> [StaticArg] -> JVal
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (StaticArg -> JExpr) -> [StaticArg] -> [JExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map StaticArg -> JExpr
    jsStaticArg