    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE TypeApplications  #-}
    {-# LANGUAGE BlockArguments    #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  GHC.StgToJS.Rts.Rts
    -- 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
    --
    -- Top level driver of the JavaScript Backend RTS. This file is an
    -- implementation of the JS RTS for the JS backend written as an EDSL in
    -- Haskell. It assumes the existence of pre-generated JS functions, included as
    -- js-sources in base. These functions are similarly assumed for non-inline
    -- Primops, See 'GHC.StgToJS.Prim'. Most of the elements in this module are
    -- constants in Haskell Land which define pieces of the JS RTS.
    --
    -----------------------------------------------------------------------------

    module GHC.StgToJS.Rts.Rts
      ( rts
      , assignRegs
      )
    where

    import GHC.Prelude

    import GHC.JS.JStg.Syntax
    import GHC.JS.JStg.Monad
    import GHC.JS.Make hiding (trace)
    import GHC.JS.Ident

    import GHC.StgToJS.Apply
    import GHC.StgToJS.Closure
    import GHC.StgToJS.Heap
    import GHC.StgToJS.Profiling
    import GHC.StgToJS.Regs
    import GHC.StgToJS.Types
    import GHC.StgToJS.Stack

    import GHC.Data.FastString
    import GHC.Types.Unique.Map

    import Data.Array
    import Data.Monoid
    import Data.Char (toLower, toUpper)
    import qualified Data.Bits          as Bits

    -- | The garbageCollector resets registers and result variables.
    garbageCollector :: JSM JStgStat
    garbageCollector :: JSM JStgStat
    garbageCollector = [JSM JStgStat] -> JSM JStgStat
    forall a. Monoid a => [JSM a] -> JSM a
    jBlock
        [ Ident -> JSM JStgStat -> JSM JStgStat
    jFunction' (FastString -> Ident
    global FastString
    "h$resetRegisters")  (JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat ([JStgStat] -> JStgStat) -> [JStgStat] -> JStgStat
    forall a b. (a -> b) -> a -> b
    $ (StgReg -> JStgStat) -> [StgReg] -> [JStgStat]
    forall a b. (a -> b) -> [a] -> [b]
    map StgReg -> JStgStat
    resetRegister [StgReg
    forall a. Bounded a => a
    minBound..StgReg
    forall a. Bounded a => a
    maxBound])
        , Ident -> JSM JStgStat -> JSM JStgStat
    jFunction' (FastString -> Ident
    global FastString
    "h$resetResultVars") (JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat ([JStgStat] -> JStgStat) -> [JStgStat] -> JStgStat
    forall a b. (a -> b) -> a -> b
    $ (StgRet -> JStgStat) -> [StgRet] -> [JStgStat]
    forall a b. (a -> b) -> [a] -> [b]
    map StgRet -> JStgStat
    resetResultVar [StgRet
    forall a. Bounded a => a
    minBound..StgRet
    forall a. Bounded a => a
    maxBound])
        ]

    -- | Reset the register 'r' in JS Land. Note that this "resets" by setting the
    -- register to a dummy variable called "null", /not/ by setting to JS's nil
    -- value.
    resetRegister :: StgReg -> JStgStat
    resetRegister :: StgReg -> JStgStat
    resetRegister StgReg
    r = StgReg -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr StgReg
    r JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    null_

    -- | Reset the return variable 'r' in JS Land. Note that this "resets" by
    -- setting the register to a dummy variable called "null", /not/ by setting to
    -- JS's nil value.
    resetResultVar :: StgRet -> JStgStat
    resetResultVar :: StgRet -> JStgStat
    resetResultVar StgRet
    r = StgRet -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr StgRet
    r JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    null_

    -- | Define closures based on size, these functions are syntactic sugar, e.g., a
    -- Haskell function which generates some useful JS. Each Closure constructor
    -- follows the naming convention h$cN, where N is a natural number. For example,
    -- h$c (with the nat omitted) is a JS Land Constructor for a closure in JS land
    -- which has a single entry function 'f', and no fields; identical to h$c0. h$c1
    -- is a JS Land Constructor for a closure with an entry function 'f', and a
    -- /single/ field 'x1', 'Just foo' is an example of this kind of closure. h$c2
    -- is a JS Land Constructor for a closure with an entry function and two data
    -- fields: 'x1' and 'x2'. And so on. Note that this has JIT performance
    -- implications; you should use h$c1, h$c2, h$c3, ... h$c24 instead of making
    -- objects manually so layouts and fields can be changed more easily and so the
    -- JIT can optimize better.
    closureConstructors :: StgToJSConfig -> JSM JStgStat
    closureConstructors :: StgToJSConfig -> JSM JStgStat
    closureConstructors StgToJSConfig
    s = do
     closures <- (Maybe Int -> JSM JStgStat)
    -> [Maybe Int] -> StateT JEnv Identity [JStgStat]
    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 Maybe Int -> JSM JStgStat
    mkClosureCon (Maybe Int
    forall a. Maybe a
    Nothing Maybe Int -> [Maybe Int] -> [Maybe Int]
    forall a. a -> [a] -> [a]
    : (Int -> Maybe Int) -> [Int] -> [Maybe Int]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> Maybe Int
    forall a. a -> Maybe a
    Just [Int
    0..Int
    jsClosureCount])
     fillers  <- mapM mkDataFill [1..jsClosureCount]
     return $ BlockStat $ closures ++ fillers

      where
        prof :: Bool
    prof = StgToJSConfig -> Bool
    csProf StgToJSConfig
    s
        ([JStgExpr]
    ccArg,Maybe JStgExpr
    ccVal)
          -- the cc argument happens to be named just like the cc field...
          | Bool
    prof      = ([Ident -> JStgExpr
    Var (Ident -> JStgExpr) -> Ident -> JStgExpr
    forall a b. (a -> b) -> a -> b
    $ FastString -> Ident
    global FastString
    closureCC_], JStgExpr -> Maybe JStgExpr
    forall a. a -> Maybe a
    Just (FastString -> JStgExpr
    var FastString
    closureCC_))
          | Bool
    otherwise = ([], Maybe JStgExpr
    forall a. Maybe a
    Nothing)

        addCCArg' :: [JStgExpr] -> [JStgExpr]
    addCCArg' [JStgExpr]
    as = [JStgExpr]
    as [JStgExpr] -> [JStgExpr] -> [JStgExpr]
    forall a. [a] -> [a] -> [a]
    ++ [JStgExpr]
    ccArg

        traceAlloc :: JStgExpr -> JStgStat
    traceAlloc JStgExpr
    x | StgToJSConfig -> Bool
    csTraceRts StgToJSConfig
    s = FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$traceAlloc" [JStgExpr
    x]
                     | Bool
    otherwise    = JStgStat
    forall a. Monoid a => a
    mempty

        notifyAlloc :: JStgExpr -> JStgStat
    notifyAlloc JStgExpr
    x | StgToJSConfig -> Bool
    csDebugAlloc StgToJSConfig
    s = FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$debugAlloc_notifyAlloc" [JStgExpr
    x]
                      | Bool
    otherwise      = JStgStat
    forall a. Monoid a => a
    mempty

        -- only JSVal can typically contain undefined or null
        -- although it's possible (and legal) to make other Haskell types
        -- to contain JS refs directly
        -- this can cause false positives here
        checkC :: JSM JStgStat
        checkC :: JSM JStgStat
    checkC | StgToJSConfig -> Bool
    csAssertRts StgToJSConfig
    s =
          (JStgExpr -> JSM JStgStat) -> JSM JStgStat
    forall t.
    (JVarMagic t, ToJExpr t) =>
    (t -> JSM JStgStat) -> JSM JStgStat
    jVar ((JStgExpr -> JSM JStgStat) -> JSM JStgStat)
    -> (JStgExpr -> JSM JStgStat) -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ \JStgExpr
    msg ->
            JStgExpr -> JStgStat -> JStgStat
    jwhenS (FastString -> JStgExpr
    var FastString
    "arguments" JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    0 JStgExpr -> JStgExpr -> JStgExpr
    .!==. FastString -> JStgExpr
    jString FastString
    "h$ghczminternalZCGHCziInternalziJSziPrimziJSVal_con_e")
            (JStgStat -> JStgStat) -> JSM JStgStat -> JSM JStgStat
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
            (JStgExpr
    -> (JStgExpr -> JStgExpr)
    -> (JStgExpr -> JSM JStgStat)
    -> JSM JStgStat
    loop JStgExpr
    1 (JStgExpr -> JStgExpr -> JStgExpr
    .<. FastString -> JStgExpr
    var FastString
    "arguments" JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "length")
              (\JStgExpr
    i ->
                  JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $
                  [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat [JStgExpr
    msg JStgExpr -> JStgExpr -> JStgStat
    |= FastString -> JStgExpr
    jString FastString
    "warning: undefined or null in argument: "
                            JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    + JStgExpr
    i
                            JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    + FastString -> JStgExpr
    jString FastString
    " allocating closure: " JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    + (FastString -> JStgExpr
    var FastString
    "arguments" JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    0 JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "n")
                          , FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$log" [JStgExpr
    msg]
                          , JStgExpr -> JStgStat -> JStgStat
    jwhenS (FastString -> JStgExpr
    var FastString
    "console" JStgExpr -> JStgExpr -> JStgExpr
    .&&. (FastString -> JStgExpr
    var FastString
    "console" JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "trace")) ((FastString -> JStgExpr
    var FastString
    "console" JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "trace") JStgExpr -> [JStgExpr] -> JStgStat
    `ApplStat` [JStgExpr
    msg])
                          , JStgExpr -> JStgStat
    postIncrS JStgExpr
    i
                          ]))
               | Bool
    otherwise = JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure JStgStat
    forall a. Monoid a => a
    mempty

        -- h$d is never used for JSVal (since it's only for constructors with
        -- at least three fields, so we always warn here
        checkD :: JSM JStgStat
    checkD | StgToJSConfig -> Bool
    csAssertRts StgToJSConfig
    s =
                         JStgExpr
    -> (JStgExpr -> JStgExpr)
    -> (JStgExpr -> JSM JStgStat)
    -> JSM JStgStat
    loop JStgExpr
    0 (JStgExpr -> JStgExpr -> JStgExpr
    .<. FastString -> JStgExpr
    var FastString
    "arguments" JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "length")
                         (\JStgExpr
    i -> JStgExpr -> JStgStat -> JStgStat
    jwhenS ((FastString -> JStgExpr
    var FastString
    "arguments" JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    i JStgExpr -> JStgExpr -> JStgExpr
    .===. JStgExpr
    null_)
                                        JStgExpr -> JStgExpr -> JStgExpr
    .||. (FastString -> JStgExpr
    var FastString
    "arguments" JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    i JStgExpr -> JStgExpr -> JStgExpr
    .===. JStgExpr
    undefined_))
                                (JStgStat -> JStgStat) -> JSM JStgStat -> JSM JStgStat
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                                ((JStgExpr -> JSM JStgStat) -> JSM JStgStat
    forall t.
    (JVarMagic t, ToJExpr t) =>
    (t -> JSM JStgStat) -> JSM JStgStat
    jVar \JStgExpr
    msg->
                                    JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $
                                    [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat [ JStgExpr
    msg JStgExpr -> JStgExpr -> JStgStat
    |= FastString -> JStgExpr
    jString FastString
    "warning: undefined or null in argument: " JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    + JStgExpr
    i JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    + FastString -> JStgExpr
    jString FastString
    " allocating fields"
                                            , JStgExpr -> JStgStat -> JStgStat
    jwhenS (FastString -> JStgExpr
    var FastString
    "console" JStgExpr -> JStgExpr -> JStgExpr
    .&&. (FastString -> JStgExpr
    var FastString
    "console" JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "trace"))
                                                    ((FastString -> JStgExpr
    var FastString
    "console" JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "trace") JStgExpr -> [JStgExpr] -> JStgStat
    `ApplStat` [JStgExpr
    msg])
                                            ]))

               | Bool
    otherwise = JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure JStgStat
    forall a. Monoid a => a
    mempty

        -- special case handler, the key difference is a call to @jFunction@ instead
        -- of @jFunctionSized@
        singleton_closure_con :: String -> JSM JStgStat
    singleton_closure_con String
    name = Ident -> (Solo JStgExpr -> JSM JStgStat) -> JSM JStgStat
    forall args.
    JSArgument args =>
    Ident -> (args -> JSM JStgStat) -> JSM JStgStat
    jFunction (FastString -> Ident
    global (FastString -> Ident) -> FastString -> Ident
    forall a b. (a -> b) -> a -> b
    $ String -> FastString
    mkFastString String
    name) ((Solo JStgExpr -> JSM JStgStat) -> JSM JStgStat)
    -> (Solo JStgExpr -> JSM JStgStat) -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $
          \(MkSolo JStgExpr
    f) -> do
            chk_c <- JSM JStgStat
    checkC
            jVar $ \JStgExpr
    x ->
              JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat ([JStgStat] -> JStgStat) -> [JStgStat] -> JStgStat
    forall a b. (a -> b) -> a -> b
    $
              [ JStgStat
    chk_c
              , JStgExpr
    x JStgExpr -> JStgExpr -> JStgStat
    |= Closure -> JStgExpr
    newClosure (JStgExpr -> [JStgExpr] -> JStgExpr -> Maybe JStgExpr -> Closure
    mkClosure JStgExpr
    f [JStgExpr]
    forall a. Monoid a => a
    mempty JStgExpr
    0 Maybe JStgExpr
    ccVal)
              , JStgExpr -> JStgStat
    notifyAlloc JStgExpr
    x
              , JStgExpr -> JStgStat
    traceAlloc JStgExpr
    x
              , JStgExpr -> JStgStat
    returnS JStgExpr
    x
              ]

        mkClosureCon :: Maybe Int -> JSM JStgStat
        -- the h$c special case
        mkClosureCon :: Maybe Int -> JSM JStgStat
    mkClosureCon Maybe Int
    Nothing  = String -> JSM JStgStat
    singleton_closure_con String
    "h$c"
        -- the h$c0 special case
        mkClosureCon (Just Int
    0) = String -> JSM JStgStat
    singleton_closure_con String
    "h$c0"
        -- the rest h$c1 .. h$c24. Note that h$c1 takes 2 arguments, one for the
        -- entry function 'f' and another for the data field 'd1'. Thus the 1 in
        -- h$c1 means 1 data field argument, not just one argument
        mkClosureCon (Just Int
    n) = Ident -> Int -> ([JStgExpr] -> JSM JStgStat) -> JSM JStgStat
    jFunctionSized Ident
    funName (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) [JStgExpr] -> JSM JStgStat
    funBod
          where
            funName :: Ident
    funName = FastString -> Ident
    global (FastString -> Ident) -> FastString -> Ident
    forall a b. (a -> b) -> a -> b
    $ Int -> FastString
    clsName Int
    n

            funBod :: [JStgExpr] -> JSM JStgStat
    funBod [] = JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure JStgStat
    forall a. Monoid a => a
    mempty -- impossible
            funBod (JStgExpr
    f:[JStgExpr]
    vars') = do
              let vars :: [JStgExpr]
    vars = [JStgExpr] -> [JStgExpr]
    addCCArg' [JStgExpr]
    vars'
              chk_c <- JSM JStgStat
    checkC
              jVar $ \JStgExpr
    x ->
                JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat ([JStgStat] -> JStgStat) -> [JStgStat] -> JStgStat
    forall a b. (a -> b) -> a -> b
    $
                [ JStgStat
    chk_c
                , JStgExpr
    x JStgExpr -> JStgExpr -> JStgStat
    |= Closure -> JStgExpr
    newClosure (JStgExpr -> [JStgExpr] -> JStgExpr -> Maybe JStgExpr -> Closure
    mkClosure JStgExpr
    f [JStgExpr]
    vars JStgExpr
    0 Maybe JStgExpr
    ccVal)
                , JStgExpr -> JStgStat
    notifyAlloc JStgExpr
    x
                , JStgExpr -> JStgStat
    traceAlloc JStgExpr
    x
                , JStgExpr -> JStgStat
    returnS JStgExpr
    x
                ]

        mkDataFill :: Int -> JSM JStgStat
        mkDataFill :: Int -> JSM JStgStat
    mkDataFill Int
    n = Ident -> Int -> ([JStgExpr] -> JSM JStgStat) -> JSM JStgStat
    jFunctionSized Ident
    funName Int
    n [JStgExpr] -> JSM JStgStat
    body
          where
            funName :: Ident
    funName    = FastString -> Ident
    global (FastString -> Ident) -> FastString -> Ident
    forall a b. (a -> b) -> a -> b
    $ Int -> FastString
    dataName Int
    n
            ds :: [FastString]
    ds         = (Int -> FastString) -> [Int] -> [FastString]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> FastString
    dataFieldName [Int
    1..Int
    n]
            extra_args :: [JStgExpr] -> JStgExpr
    extra_args [JStgExpr]
    as = JVal -> JStgExpr
    ValExpr (JVal -> JStgExpr)
    -> ([(FastString, JStgExpr)] -> JVal)
    -> [(FastString, JStgExpr)]
    -> JStgExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . UniqMap FastString JStgExpr -> JVal
    JHash
                            (UniqMap FastString JStgExpr -> JVal)
    -> ([(FastString, JStgExpr)] -> UniqMap FastString JStgExpr)
    -> [(FastString, JStgExpr)]
    -> JVal
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(FastString, JStgExpr)] -> UniqMap FastString JStgExpr
    forall k a. Uniquable k => [(k, a)] -> UniqMap k a
    listToUniqMap
                            ([(FastString, JStgExpr)] -> JStgExpr)
    -> [(FastString, JStgExpr)] -> JStgExpr
    forall a b. (a -> b) -> a -> b
    $ [FastString] -> [JStgExpr] -> [(FastString, JStgExpr)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [FastString]
    ds [JStgExpr]
    as
            body :: [JStgExpr] -> JSM JStgStat
            body :: [JStgExpr] -> JSM JStgStat
    body [JStgExpr]
    ids = do
              c <- JSM JStgStat
    checkD
              return (c <> returnS (extra_args ids))

    -- | JS Payload to perform stack manipulation in the RTS
    stackManip :: JSM JStgStat
    stackManip :: JSM JStgStat
    stackManip = do
      pushes  <- (Int -> JSM JStgStat) -> [Int] -> StateT JEnv Identity [JStgStat]
    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 Int -> JSM JStgStat
    mkPush [Int
    1..Int
    32]
      ppushes <- mapM mkPpush [1..255]
      return $ mconcat $ pushes ++ ppushes
      where
        mkPush :: Int -> JSM JStgStat
        mkPush :: Int -> JSM JStgStat
    mkPush Int
    n = let funName :: Ident
    funName = FastString -> Ident
    global (FastString -> Ident) -> FastString -> Ident
    forall a b. (a -> b) -> a -> b
    $ String -> FastString
    mkFastString (String
    "h$p" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    n)
                       body :: [JStgExpr] -> JSM JStgStat
    body [JStgExpr]
    as = JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $
                         ((JStgExpr
    sp JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    sp JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    + Int -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr Int
    n)
                           JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat ((Int -> JStgExpr -> JStgStat) -> [Int] -> [JStgExpr] -> [JStgStat]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\Int
    i JStgExpr
    a -> JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! (JStgExpr
    sp JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    - Int -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    i)) JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    a)
                                                [Int
    1..] [JStgExpr]
    as))
                   in Ident -> Int -> ([JStgExpr] -> JSM JStgStat) -> JSM JStgStat
    jFunctionSized Ident
    funName Int
    n [JStgExpr] -> JSM JStgStat
    body

        -- partial pushes, based on bitmap, increases Sp by highest bit
        mkPpush :: Integer -> JSM JStgStat
        mkPpush :: Integer -> JSM JStgStat
    mkPpush Integer
    sig | Integer
    sig Integer -> Integer -> Integer
    forall a. Bits a => a -> a -> a
    Bits..&. (Integer
    sigInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    1) Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    0 = JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure JStgStat
    forall a. Monoid a => a
    mempty -- already handled by h$p
        mkPpush Integer
    sig = let funName :: Ident
    funName = FastString -> Ident
    global (FastString -> Ident) -> FastString -> Ident
    forall a b. (a -> b) -> a -> b
    $ String -> FastString
    mkFastString (String
    "h$pp" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Integer -> String
    forall a. Show a => a -> String
    show Integer
    sig)
                          bits :: [Int]
    bits    = Integer -> [Int]
    bitsIdx Integer
    sig
                          h :: Int
    h       = [Int] -> Int
    forall a. HasCallStack => [a] -> a
    last [Int]
    bits
                          body :: [JStgExpr] -> JSM JStgStat
    body [JStgExpr]
    args = JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $
                            [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat [ JStgExpr
    sp JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    sp JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    + Int -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr (Int
    hInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)
                                    , [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat ((Int -> JStgExpr -> JStgStat) -> [Int] -> [JStgExpr] -> [JStgStat]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\Int
    b JStgExpr
    a -> JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! (JStgExpr
    sp JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    - Int -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr (Int
    hInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    b)) JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    a) [Int]
    bits [JStgExpr]
    args)
                                    ]
                       in Ident -> Int -> ([JStgExpr] -> JSM JStgStat) -> JSM JStgStat
    jFunctionSized Ident
    funName ([Int] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Int]
    bits) [JStgExpr] -> JSM JStgStat
    body

    bitsIdx :: Integer -> [Int]
    bitsIdx :: Integer -> [Int]
    bitsIdx Integer
    n | Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Integer
    0 = String -> [Int]
    forall a. HasCallStack => String -> a
    error String
    "bitsIdx: negative"
              | Bool
    otherwise = Integer -> Int -> [Int]
    forall {t}. (Num t, Bits t) => t -> Int -> [Int]
    go Integer
    n Int
    0
      where
        go :: t -> Int -> [Int]
    go t
    0 Int
    _ = []
        go t
    m Int
    b | t -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    Bits.testBit t
    m Int
    b = Int
    b Int -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    : t -> Int -> [Int]
    go (t -> Int -> t
    forall a. Bits a => a -> Int -> a
    Bits.clearBit t
    m Int
    b) (Int
    bInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)
               | Bool
    otherwise   = t -> Int -> [Int]
    go (t -> Int -> t
    forall a. Bits a => a -> Int -> a
    Bits.clearBit t
    m Int
    b) (Int
    bInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)

    bhLneStats :: StgToJSConfig -> JStgExpr -> JStgExpr -> JSM JStgStat
    bhLneStats :: StgToJSConfig -> JStgExpr -> JStgExpr -> JSM JStgStat
    bhLneStats StgToJSConfig
    _s JStgExpr
    p JStgExpr
    frameSize = (JStgExpr -> JSM JStgStat) -> JSM JStgStat
    forall t.
    (JVarMagic t, ToJExpr t) =>
    (t -> JSM JStgStat) -> JSM JStgStat
    jVar ((JStgExpr -> JSM JStgStat) -> JSM JStgStat)
    -> (JStgExpr -> JSM JStgStat) -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ \JStgExpr
    v ->
      JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat
      [ JStgExpr
    v JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    p
      , JStgExpr -> JStgStat -> JStgStat -> JStgStat
    ifS JStgExpr
    v
        ((JStgExpr
    sp JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    sp JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    - JStgExpr
    frameSize)
          JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> JStgExpr -> JStgStat -> JStgStat -> JStgStat
    ifS (JStgExpr
    v JStgExpr -> JStgExpr -> JStgExpr
    .===. FastString -> JStgExpr
    var FastString
    "h$blackhole")
          (JStgExpr -> JStgStat
    returnS (JStgExpr -> JStgStat) -> JStgExpr -> JStgStat
    forall a b. (a -> b) -> a -> b
    $ FastString -> [JStgExpr] -> JStgExpr
    app FastString
    "h$throw" [FastString -> JStgExpr
    var FastString
    "h$ghczminternalZCGHCziInternalziControlziExceptionziBasezinonTermination", JStgExpr
    false_])
          ([JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat [JStgExpr
    r1 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    v
                   , JStgExpr
    sp JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    sp JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    - JStgExpr
    frameSize
                   , JStgStat
    returnStack
                   ]))
        ((JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    p JStgExpr -> JStgExpr -> JStgStat
    |= FastString -> JStgExpr
    var FastString
    "h$blackhole") JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> JStgExpr -> JStgStat
    returnS JStgExpr
    null_)
      ]

    -- | JS payload to declare the registers
    declRegs :: JSM JStgStat
    declRegs :: JSM JStgStat
    declRegs = do
        getters_setters <- JSM JStgStat
    regGettersSetters
        loaders         <- loadRegs
        return $
          mconcat [ global "h$regs" ||= toJExpr (JList [])
                  , mconcat (map declReg (enumFromTo R1 R32))
                  , getters_setters
                  , loaders
                  ]
        where
          declReg :: a -> JStgStat
    declReg a
    r = (Ident -> JStgStat
    decl (Ident -> JStgStat) -> (a -> Ident) -> a -> JStgStat
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FastString -> Ident
    global (FastString -> Ident) -> (a -> FastString) -> a -> Ident
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> FastString
    mkFastString (String -> FastString) -> (a -> String) -> a -> FastString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String
    "h$"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) (String -> String) -> (a -> String) -> a -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower (String -> String) -> (a -> String) -> a -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> String
    forall a. Show a => a -> String
    show) a
    r
                      JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> [JStgStat] -> JStgStat
    BlockStat [a -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr a
    r JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    zero_]

    -- | JS payload to define getters and setters on the registers.
    regGettersSetters :: JSM JStgStat
    regGettersSetters :: JSM JStgStat
    regGettersSetters =
      do setters <- Ident -> (Solo JStgExpr -> JSM JStgStat) -> JSM JStgStat
    forall args.
    JSArgument args =>
    Ident -> (args -> JSM JStgStat) -> JSM JStgStat
    jFunction (FastString -> Ident
    global FastString
    "h$getReg") (\(MkSolo JStgExpr
    n) -> JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ JStgExpr -> [(JStgExpr, JStgStat)] -> JStgStat -> JStgStat
    SwitchStat JStgExpr
    n [(JStgExpr, JStgStat)]
    getRegCases JStgStat
    forall a. Monoid a => a
    mempty)
         getters <- jFunction (global "h$setReg") (\(JStgExpr
    n,JStgExpr
    v)    -> JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ JStgExpr -> [(JStgExpr, JStgStat)] -> JStgStat -> JStgStat
    SwitchStat JStgExpr
    n (JStgExpr -> [(JStgExpr, JStgStat)]
    setRegCases JStgExpr
    v) JStgStat
    forall a. Monoid a => a
    mempty)
         return $ setters <> getters
      where
        getRegCases :: [(JStgExpr, JStgStat)]
    getRegCases =
          (StgReg -> (JStgExpr, JStgStat))
    -> [StgReg] -> [(JStgExpr, JStgStat)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\StgReg
    r -> (Int -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr (StgReg -> Int
    jsRegToInt StgReg
    r) , JStgExpr -> JStgStat
    returnS (StgReg -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr StgReg
    r))) [StgReg]
    regsFromR1
        setRegCases :: JStgExpr -> [(JStgExpr,JStgStat)]
        setRegCases :: JStgExpr -> [(JStgExpr, JStgStat)]
    setRegCases JStgExpr
    v =
          (StgReg -> (JStgExpr, JStgStat))
    -> [StgReg] -> [(JStgExpr, JStgStat)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\StgReg
    r -> (Int -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr (StgReg -> Int
    jsRegToInt StgReg
    r), (StgReg -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr StgReg
    r JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr JStgExpr
    v) JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> JStgExpr -> JStgStat
    returnS JStgExpr
    undefined_)) [StgReg]
    regsFromR1

    -- | JS payload that defines the functions to load each register
    loadRegs :: JSM JStgStat
    loadRegs :: JSM JStgStat
    loadRegs = [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat ([JStgStat] -> JStgStat)
    -> StateT JEnv Identity [JStgStat] -> JSM JStgStat
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Int -> JSM JStgStat) -> [Int] -> StateT JEnv Identity [JStgStat]
    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 Int -> JSM JStgStat
    mkLoad [Int
    1..Int
    32]
      where
        mkLoad :: Int -> JSM JStgStat
        mkLoad :: Int -> JSM JStgStat
    mkLoad Int
    n = let body :: [JStgExpr] -> JSM JStgStat
    body  = \[JStgExpr]
    args -> JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat ([JStgStat] -> JStgStat) -> [JStgStat] -> JStgStat
    forall a b. (a -> b) -> a -> b
    $
                               (JStgExpr -> StgReg -> JStgStat)
    -> [JStgExpr] -> [StgReg] -> [JStgStat]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\JStgExpr
    a StgReg
    r -> StgReg -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr StgReg
    r JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    a)
                               [JStgExpr]
    args ([StgReg] -> [StgReg]
    forall a. [a] -> [a]
    reverse ([StgReg] -> [StgReg]) -> [StgReg] -> [StgReg]
    forall a b. (a -> b) -> a -> b
    $ Int -> [StgReg] -> [StgReg]
    forall a. Int -> [a] -> [a]
    take Int
    n [StgReg]
    regsFromR1)
                       fname :: Ident
    fname = FastString -> Ident
    global (FastString -> Ident) -> FastString -> Ident
    forall a b. (a -> b) -> a -> b
    $ String -> FastString
    mkFastString (String
    "h$l" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    n)
                   in Ident -> Int -> ([JStgExpr] -> JSM JStgStat) -> JSM JStgStat
    jFunctionSized Ident
    fname Int
    n [JStgExpr] -> JSM JStgStat
    body

    -- | Assign registers R1 ... Rn in descending order, that is assign Rn first.
    -- This function uses the 'assignRegs'' array to construct functions which set
    -- the registers.
    assignRegs :: StgToJSConfig -> [JStgExpr] -> JStgStat
    assignRegs :: StgToJSConfig -> [JStgExpr] -> JStgStat
    assignRegs StgToJSConfig
    _ [] = JStgStat
    forall a. Monoid a => a
    mempty
    assignRegs StgToJSConfig
    s [JStgExpr]
    xs
      | Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    32 Bool -> Bool -> Bool
    && Bool -> Bool
    not (StgToJSConfig -> Bool
    csInlineLoadRegs StgToJSConfig
    s)
          = JStgExpr -> [JStgExpr] -> JStgStat
    ApplStat (JVal -> JStgExpr
    ValExpr (Ident -> JVal
    JVar (Ident -> JVal) -> Ident -> JVal
    forall a b. (a -> b) -> a -> b
    $ Array Int Ident
    assignRegs' Array Int Ident -> Int -> Ident
    forall i e. Ix i => Array i e -> i -> e
    ! Int
    l)) ([JStgExpr] -> [JStgExpr]
    forall a. [a] -> [a]
    reverse [JStgExpr]
    xs)
      | Bool
    otherwise = [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat ([JStgStat] -> JStgStat)
    -> ([JStgStat] -> [JStgStat]) -> [JStgStat] -> JStgStat
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [JStgStat] -> [JStgStat]
    forall a. [a] -> [a]
    reverse ([JStgStat] -> JStgStat) -> [JStgStat] -> JStgStat
    forall a b. (a -> b) -> a -> b
    $
          (StgReg -> JStgExpr -> JStgStat)
    -> [StgReg] -> [JStgExpr] -> [JStgStat]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\StgReg
    r JStgExpr
    ex -> StgReg -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr StgReg
    r JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    ex) (Int -> [StgReg] -> [StgReg]
    forall a. Int -> [a] -> [a]
    take Int
    l [StgReg]
    regsFromR1) [JStgExpr]
    xs
      where
        l :: Int
    l = [JStgExpr] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [JStgExpr]
    xs

    -- | JS payload which defines an array of function symbols that set N registers
    -- from M parameters. For example, h$l2 compiles to:
    -- @
    --    function h$l4(x1, x2, x3, x4) {
    --      h$r4 = x1;
    --      h$r3 = x2;
    --      h$r2 = x3;
    --      h$r1 = x4;
    --    };
    -- @
    assignRegs' :: Array Int Ident
    assignRegs' :: Array Int Ident
    assignRegs' = (Int, Int) -> [Ident] -> Array Int Ident
    forall i e. Ix i => (i, i) -> [e] -> Array i e
    listArray (Int
    1,Int
    32) ((Int -> Ident) -> [Int] -> [Ident]
    forall a b. (a -> b) -> [a] -> [b]
    map (FastString -> Ident
    global (FastString -> Ident) -> (Int -> FastString) -> Int -> Ident
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> FastString
    mkFastString (String -> FastString) -> (Int -> String) -> Int -> FastString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String
    "h$l"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) (String -> String) -> (Int -> String) -> Int -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String
    forall a. Show a => a -> String
    show) [(Int
    1::Int)..Int
    32])

    -- | JS payload to declare return variables.
    declRets :: JStgStat
    declRets :: JStgStat
    declRets = [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat ([JStgStat] -> JStgStat) -> [JStgStat] -> JStgStat
    forall a b. (a -> b) -> a -> b
    $ (StgRet -> JStgStat) -> [StgRet] -> [JStgStat]
    forall a b. (a -> b) -> [a] -> [b]
    map (Ident -> JStgStat
    decl (Ident -> JStgStat) -> (StgRet -> Ident) -> StgRet -> JStgStat
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FastString -> Ident
    global (FastString -> Ident) -> (StgRet -> FastString) -> StgRet -> Ident
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> FastString
    mkFastString (String -> FastString)
    -> (StgRet -> String) -> StgRet -> FastString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String
    "h$"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) (String -> String) -> (StgRet -> String) -> StgRet -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower (String -> String) -> (StgRet -> String) -> StgRet -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StgRet -> String
    forall a. Show a => a -> String
    show) (StgRet -> [StgRet]
    forall a. Enum a => a -> [a]
    enumFrom StgRet
    Ret1)

    -- | JS payload defining the types closures.
    closureTypes :: JSM JStgStat
    closureTypes :: JSM JStgStat
    closureTypes = do
      cls_typ_nm <- JSM JStgStat
    closureTypeName
      return $
        mconcat (map mkClosureType (enumFromTo minBound maxBound))
        <> cls_typ_nm
      where
        mkClosureType :: ClosureType -> JStgStat
        mkClosureType :: ClosureType -> JStgStat
    mkClosureType ClosureType
    c = let s :: Ident
    s = FastString -> Ident
    global (FastString -> Ident) -> (String -> FastString) -> String -> Ident
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> FastString
    mkFastString (String -> Ident) -> String -> Ident
    forall a b. (a -> b) -> a -> b
    $ String
    "h$" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toUpper (ClosureType -> String
    forall a. Show a => a -> String
    show ClosureType
    c) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "_CLOSURE"
                          in  Ident
    s Ident -> JStgExpr -> JStgStat
    ||= ClosureType -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr ClosureType
    c
        closureTypeName :: JSM JStgStat
        closureTypeName :: JSM JStgStat
    closureTypeName = Ident -> (Solo JStgExpr -> JSM JStgStat) -> JSM JStgStat
    forall args.
    JSArgument args =>
    Ident -> (args -> JSM JStgStat) -> JSM JStgStat
    jFunction (FastString -> Ident
    global FastString
    "h$closureTypeName")
                          \(MkSolo JStgExpr
    c) -> JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $
                                  [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat ((ClosureType -> JStgStat) -> [ClosureType] -> [JStgStat]
    forall a b. (a -> b) -> [a] -> [b]
    map (JStgExpr -> ClosureType -> JStgStat
    ifCT JStgExpr
    c) [ClosureType
    forall a. Bounded a => a
    minBound..ClosureType
    forall a. Bounded a => a
    maxBound])
                                  JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> JStgExpr -> JStgStat
    returnS (FastString -> JStgExpr
    jString FastString
    "InvalidClosureType")

        ifCT :: JStgExpr -> ClosureType -> JStgStat
        ifCT :: JStgExpr -> ClosureType -> JStgStat
    ifCT JStgExpr
    arg ClosureType
    ct = JStgExpr -> JStgStat -> JStgStat
    jwhenS (JStgExpr
    arg JStgExpr -> JStgExpr -> JStgExpr
    .===. ClosureType -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr ClosureType
    ct) (JStgExpr -> JStgStat
    returnS (String -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr (ClosureType -> String
    forall a. Show a => a -> String
    show ClosureType
    ct)))

    -- | JS payload declaring the RTS functions.
    rtsDecls :: JSM JStgStat
    rtsDecls :: JSM JStgStat
    rtsDecls = do
      decl_stg_regs <- JSM JStgStat
    declRegs
      return $
        mconcat [ global "h$currentThread"   ||= null_                   -- thread state object for current thread
                , global "h$stack"           ||= null_                   -- stack for the current thread
                , global "h$sp"              ||= 0                       -- stack pointer for the current thread
                , global "h$initStatic"      ||= toJExpr (JList [])      -- we need delayed initialization for static objects, push functions here to be initialized just before haskell runs
                , global "h$staticThunks"    ||= toJExpr (jhFromList []) --  funcName -> heapidx map for srefs
                , global "h$staticThunksArr" ||= toJExpr (JList [])      -- indices of updatable thunks in static heap
                , global "h$CAFs"            ||= toJExpr (JList [])
                , global "h$CAFsReset"       ||= toJExpr (JList [])
                -- stg registers
                , decl_stg_regs
                , declRets]

    -- | Generated RTS code
    rts :: StgToJSConfig -> JSM JStgStat
    rts :: StgToJSConfig -> JSM JStgStat
    rts StgToJSConfig
    cfg = FastString -> JSM JStgStat -> JSM JStgStat
    forall a. FastString -> JSM a -> JSM a
    withTag FastString
    "h$RTS" (JSM JStgStat -> JSM JStgStat) -> JSM JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $
      do
      rts_      <- StgToJSConfig -> JSM JStgStat
    rts_gen StgToJSConfig
    cfg
      rts_decls <- rtsDecls
      return $  rts_decls <> rts_

    -- | JS Payload which defines the embedded RTS.
    rts_gen :: StgToJSConfig -> JSM JStgStat
    rts_gen :: StgToJSConfig -> JSM JStgStat
    rts_gen StgToJSConfig
    s = do
      let decls :: [JStgStat]
    decls = [ FastString -> Ident
    global FastString
    "h$rts_traceForeign" Ident -> JStgExpr -> JStgStat
    ||= Bool -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr (StgToJSConfig -> Bool
    csTraceForeign StgToJSConfig
    s)
                  , FastString -> Ident
    global FastString
    "h$rts_profiling"    Ident -> JStgExpr -> JStgStat
    ||= Bool -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr (StgToJSConfig -> Bool
    csProf StgToJSConfig
    s)
                  , FastString -> Ident
    global FastString
    "h$ct_fun"        Ident -> JStgExpr -> JStgStat
    ||= ClosureType -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr ClosureType
    Fun
                  , FastString -> Ident
    global FastString
    "h$ct_con"        Ident -> JStgExpr -> JStgStat
    ||= ClosureType -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr ClosureType
    Con
                  , FastString -> Ident
    global FastString
    "h$ct_thunk"      Ident -> JStgExpr -> JStgStat
    ||= ClosureType -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr ClosureType
    Thunk
                  , FastString -> Ident
    global FastString
    "h$ct_pap"        Ident -> JStgExpr -> JStgStat
    ||= ClosureType -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr ClosureType
    Pap
                  , FastString -> Ident
    global FastString
    "h$ct_blackhole"  Ident -> JStgExpr -> JStgStat
    ||= ClosureType -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr ClosureType
    Blackhole
                  , FastString -> Ident
    global FastString
    "h$ct_stackframe" Ident -> JStgExpr -> JStgStat
    ||= ClosureType -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr ClosureType
    StackFrame
                  , FastString -> Ident
    global FastString
    "h$vt_ptr"    Ident -> JStgExpr -> JStgStat
    ||= JSRep -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr JSRep
    PtrV
                  , FastString -> Ident
    global FastString
    "h$vt_void"   Ident -> JStgExpr -> JStgStat
    ||= JSRep -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr JSRep
    VoidV
                  , FastString -> Ident
    global FastString
    "h$vt_double" Ident -> JStgExpr -> JStgStat
    ||= JSRep -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr JSRep
    IntV
                  , FastString -> Ident
    global FastString
    "h$vt_long"   Ident -> JStgExpr -> JStgStat
    ||= JSRep -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr JSRep
    LongV
                  , FastString -> Ident
    global FastString
    "h$vt_addr"   Ident -> JStgExpr -> JStgStat
    ||= JSRep -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr JSRep
    AddrV
                  , FastString -> Ident
    global FastString
    "h$vt_obj"    Ident -> JStgExpr -> JStgStat
    ||= JSRep -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr JSRep
    ObjV
                  , FastString -> Ident
    global FastString
    "h$vt_arr"    Ident -> JStgExpr -> JStgStat
    ||= JSRep -> JStgExpr
    forall a. ToJExpr a => a -> JStgExpr
    toJExpr JSRep
    ArrV
                  ]
      gc           <- JSM JStgStat
    garbageCollector
      closure_cons <- closureConstructors s
      stk_manip    <- stackManip
      rest         <- impure
      return $ mconcat $ pure gc <> decls <> [closure_cons, stk_manip] <> rest
      where
        impure :: StateT JEnv Identity [JStgStat]
    impure = [JSM JStgStat] -> StateT JEnv Identity [JStgStat]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence
                 [ Ident -> JSM JStgStat -> JSM JStgStat
    jFunction' (FastString -> Ident
    global FastString
    "h$bh")     (JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ StgToJSConfig -> Bool -> JStgStat
    bhStats StgToJSConfig
    s Bool
    True)
                 , Ident -> ((JStgExpr, JStgExpr) -> JSM JStgStat) -> JSM JStgStat
    forall args.
    JSArgument args =>
    Ident -> (args -> JSM JStgStat) -> JSM JStgStat
    jFunction (FastString -> Ident
    global FastString
    "h$bh_lne") (\(JStgExpr
    x, JStgExpr
    frameSize) -> StgToJSConfig -> JStgExpr -> JStgExpr -> JSM JStgStat
    bhLneStats StgToJSConfig
    s JStgExpr
    x JStgExpr
    frameSize)
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$blackhole") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 []) FastString
    "blackhole" (Int -> CILayout
    CILayoutUnknown Int
    2) CIType
    CIBlackhole CIStatic
    forall a. Monoid a => a
    mempty)
                   (JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "throw" [FastString -> JStgExpr
    jString FastString
    "oops: entered black hole"])
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$blackholeTrap") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 []) FastString
    "blackhole" (Int -> CILayout
    CILayoutUnknown Int
    2) CIType
    CIThunk CIStatic
    forall a. Monoid a => a
    mempty)
                   (JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "throw" [FastString -> JStgExpr
    jString FastString
    "oops: entered multiple times"])
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$done") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "done" (Int -> CILayout
    CILayoutUnknown Int
    0) CIType
    CIStackFrame CIStatic
    forall a. Monoid a => a
    mempty)
                   (JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$finishThread" [FastString -> JStgExpr
    var FastString
    "h$currentThread"] JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> JStgExpr -> JStgStat
    returnS (FastString -> JStgExpr
    var FastString
    "h$reschedule"))
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$doneMain_e") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "doneMain" (Int -> CILayout
    CILayoutUnknown Int
    0) CIType
    CIStackFrame CIStatic
    forall a. Monoid a => a
    mempty)
                   (JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ JStgExpr -> JStgStat
    returnS (FastString -> JStgExpr
    var FastString
    "h$doneMain"))
                 , Ident -> FastString -> CILayout -> Int -> JSM JStgStat
    conClosure (FastString -> Ident
    global FastString
    "h$false_e") FastString
    "GHC.Types.False" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    0 []) Int
    1
                 , Ident -> FastString -> CILayout -> Int -> JSM JStgStat
    conClosure (FastString -> Ident
    global FastString
    "h$true_e" ) FastString
    "GHC.Types.True"  (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    0 []) Int
    2
                 -- generic data constructor with 1 non-heapobj field
                 , Ident -> FastString -> CILayout -> Int -> JSM JStgStat
    conClosure (FastString -> Ident
    global FastString
    "h$data1_e") FastString
    "data1" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    1 [JSRep
    ObjV]) Int
    1
                 -- generic data constructor with 2 non-heapobj fields
                 , Ident -> FastString -> CILayout -> Int -> JSM JStgStat
    conClosure (FastString -> Ident
    global FastString
    "h$data2_e") FastString
    "data2" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    2 [JSRep
    ObjV,JSRep
    ObjV]) Int
    1
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$noop_e") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    1 [JSRep
    PtrV]) FastString
    "no-op IO ()" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    0 []) (Int -> Int -> CIType
    CIFun Int
    1 Int
    0) CIStatic
    forall a. Monoid a => a
    mempty)
                   (JSM JStgStat -> JSM JStgStat) -> JSM JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgExpr -> JStgStat
    returnS (JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    sp))
                 , JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (FastString -> Ident
    global FastString
    "h$noop" Ident -> JStgExpr -> JStgStat
    ||= JStgExpr -> [JStgExpr] -> JStgExpr
    ApplExpr (FastString -> JStgExpr
    var FastString
    "h$c0") (FastString -> JStgExpr
    var FastString
    "h$noop_e" JStgExpr -> [JStgExpr] -> [JStgExpr]
    forall a. a -> [a] -> [a]
    : [JStgExpr
    jSystemCCS | StgToJSConfig -> Bool
    csProf StgToJSConfig
    s]))
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$catch_e") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "exception handler" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    2 [JSRep
    PtrV,JSRep
    IntV]) CIType
    CIStackFrame CIStatic
    forall a. Monoid a => a
    mempty)
                      (JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ Int -> JStgStat
    adjSpN' Int
    3 JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> JStgExpr -> JStgStat
    returnS (JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    sp))
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$dataToTag_e") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "data to tag" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    0 []) CIType
    CIStackFrame CIStatic
    forall a. Monoid a => a
    mempty)
                       (JSM JStgStat -> JSM JStgStat) -> JSM JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat [ JStgExpr
    r1 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr -> JStgExpr -> JStgExpr -> JStgExpr
    if_ (JStgExpr
    r1 JStgExpr -> JStgExpr -> JStgExpr
    .===. JStgExpr
    true_) JStgExpr
    1 (JStgExpr -> JStgExpr -> JStgExpr -> JStgExpr
    if_ (JStgExpr -> JStgExpr
    typeof JStgExpr
    r1 JStgExpr -> JStgExpr -> JStgExpr
    .===. JStgExpr
    jTyObject) (JStgExpr
    r1 JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "f" JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "a" JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    - JStgExpr
    1) JStgExpr
    0)
                                          , Int -> JStgStat
    adjSpN' Int
    1
                                          , JStgExpr -> JStgStat
    returnS (JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    sp)
                                          ]
                 -- function application to one argument
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$ap1_e") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "apply1" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    2 [JSRep
    PtrV, JSRep
    PtrV]) CIType
    CIThunk CIStatic
    forall a. Monoid a => a
    mempty)
                      (((JStgExpr, JStgExpr) -> JSM JStgStat) -> JSM JStgStat
    forall args.
    JSArgument args =>
    (args -> JSM JStgStat) -> JSM JStgStat
    jVars \(JStgExpr
    d1, JStgExpr
    d2) -> JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $
                                    [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat [ JStgExpr
    d1 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr -> JStgExpr
    closureField1 JStgExpr
    r1
                                            , JStgExpr
    d2 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr -> JStgExpr
    closureField2 JStgExpr
    r1
                                            , FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$bh" []
                                            , StgToJSConfig -> JStgStat -> JStgStat
    profStat StgToJSConfig
    s JStgStat
    enterCostCentreThunk
                                            , JStgExpr
    r1 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    d1
                                            , JStgExpr
    r2 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    d2
                                            , JStgExpr -> JStgStat
    returnS (FastString -> [JStgExpr] -> JStgExpr
    app FastString
    "h$ap_1_1_fast" [])
                                            ])
                 -- function application to two arguments
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$ap2_e") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "apply2" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    3 [JSRep
    PtrV, JSRep
    PtrV, JSRep
    PtrV]) CIType
    CIThunk CIStatic
    forall a. Monoid a => a
    mempty)
                      (((JStgExpr, JStgExpr, JStgExpr) -> JSM JStgStat) -> JSM JStgStat
    forall args.
    JSArgument args =>
    (args -> JSM JStgStat) -> JSM JStgStat
    jVars \(JStgExpr
    d1, JStgExpr
    d2, JStgExpr
    d3) -> JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $
                                        [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat [ JStgExpr
    d1 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr -> JStgExpr
    closureField1 JStgExpr
    r1
                                                , JStgExpr
    d2 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr -> JStgExpr
    closureField2 JStgExpr
    r1 JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "d1"
                                                , JStgExpr
    d3 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr -> JStgExpr
    closureField2 JStgExpr
    r1 JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "d2"
                                                , FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$bh" []
                                                , StgToJSConfig -> JStgStat -> JStgStat
    profStat StgToJSConfig
    s JStgStat
    enterCostCentreThunk
                                                , JStgExpr
    r1 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    d1
                                                , JStgExpr
    r2 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    d2
                                                , JStgExpr
    r3 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    d3
                                                , JStgExpr -> JStgStat
    returnS (FastString -> [JStgExpr] -> JStgExpr
    app FastString
    "h$ap_2_2_fast" [])
                                                ])
                 -- function application to three arguments
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$ap3_e") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "apply3" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    4 [JSRep
    PtrV, JSRep
    PtrV, JSRep
    PtrV, JSRep
    PtrV]) CIType
    CIThunk CIStatic
    forall a. Monoid a => a
    mempty)
                      (((JStgExpr, JStgExpr, JStgExpr, JStgExpr) -> JSM JStgStat)
    -> JSM JStgStat
    forall args.
    JSArgument args =>
    (args -> JSM JStgStat) -> JSM JStgStat
    jVars \(JStgExpr
    d1, JStgExpr
    d2, JStgExpr
    d3, JStgExpr
    d4) -> JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $
                                            [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat [ JStgExpr
    d1 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr -> JStgExpr
    closureField1 JStgExpr
    r1
                                                    , JStgExpr
    d2 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr -> JStgExpr
    closureField2 JStgExpr
    r1 JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "d1"
                                                    , JStgExpr
    d3 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr -> JStgExpr
    closureField2 JStgExpr
    r1 JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "d2"
                                                    , JStgExpr
    d4 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr -> JStgExpr
    closureField2 JStgExpr
    r1 JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "d3"
                                                    , FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$bh" []
                                                    , JStgExpr
    r1 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    d1
                                                    , JStgExpr
    r2 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    d2
                                                    , JStgExpr
    r3 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    d3
                                                    , JStgExpr
    r4 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    d4
                                                    , JStgExpr -> JStgStat
    returnS (FastString -> [JStgExpr] -> JStgExpr
    app FastString
    "h$ap_3_3_fast" [])
                                                    ])
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    TxtI FastString
    "h$upd_thunk_e") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "updatable thunk" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    1 [JSRep
    PtrV]) CIType
    CIThunk CIStatic
    forall a. Monoid a => a
    mempty)
                   ((JStgExpr -> JSM JStgStat) -> JSM JStgStat
    forall t.
    (JVarMagic t, ToJExpr t) =>
    (t -> JSM JStgStat) -> JSM JStgStat
    jVar ((JStgExpr -> JSM JStgStat) -> JSM JStgStat)
    -> (JStgExpr -> JSM JStgStat) -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ \JStgExpr
    t -> JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $
                       [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat [JStgExpr
    t JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr -> JStgExpr
    closureField1 JStgExpr
    r1
                               , Int -> JStgStat
    adjSp' Int
    2
                               , JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! (JStgExpr
    sp JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    - JStgExpr
    1) JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    r1
                               , JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    sp       JStgExpr -> JStgExpr -> JStgStat
    |= FastString -> JStgExpr
    var FastString
    "h$upd_frame"
                               , JStgExpr -> JStgExpr
    closureEntry  JStgExpr
    r1 JStgExpr -> JStgExpr -> JStgStat
    |= FastString -> JStgExpr
    var FastString
    "h$blackhole"
                               , JStgExpr -> JStgExpr
    closureField1 JStgExpr
    r1 JStgExpr -> JStgExpr -> JStgStat
    |= FastString -> JStgExpr
    var FastString
    "h$currentThread"
                               , JStgExpr -> JStgExpr
    closureField2 JStgExpr
    r1 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    null_
                               , JStgExpr
    r1 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    t
                               , JStgExpr -> JStgStat
    returnS (FastString -> [JStgExpr] -> JStgExpr
    app FastString
    "h$ap_0_0_fast" [])
                               ]
                      )
                 -- select first field
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$select1_e") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "select1" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    1 [JSRep
    PtrV]) CIType
    CIThunk CIStatic
    forall a. Monoid a => a
    mempty)
                      ((JStgExpr -> JSM JStgStat) -> JSM JStgStat
    forall t.
    (JVarMagic t, ToJExpr t) =>
    (t -> JSM JStgStat) -> JSM JStgStat
    jVar \JStgExpr
    t -> JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $
                               [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat [ JStgExpr
    t JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr -> JStgExpr
    closureField1 JStgExpr
    r1
                                       , Int -> JStgStat
    adjSp' Int
    3
                                       , JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! (JStgExpr
    sp JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    - JStgExpr
    2) JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    r1
                                       , JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! (JStgExpr
    sp JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    - JStgExpr
    1) JStgExpr -> JStgExpr -> JStgStat
    |= FastString -> JStgExpr
    var FastString
    "h$upd_frame"
                                       , JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    sp JStgExpr -> JStgExpr -> JStgStat
    |= FastString -> JStgExpr
    var FastString
    "h$select1_ret"
                                       , JStgExpr -> JStgExpr
    closureEntry  JStgExpr
    r1 JStgExpr -> JStgExpr -> JStgStat
    |= FastString -> JStgExpr
    var FastString
    "h$blackhole"
                                       , JStgExpr -> JStgExpr
    closureField1 JStgExpr
    r1 JStgExpr -> JStgExpr -> JStgStat
    |= FastString -> JStgExpr
    var FastString
    "h$currentThread"
                                       , JStgExpr -> JStgExpr
    closureField2 JStgExpr
    r1 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    null_
                                       , JStgExpr
    r1 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    t
                                       , JStgExpr -> JStgStat
    returnS (FastString -> [JStgExpr] -> JStgExpr
    app FastString
    "h$ap_0_0_fast" [])
                                       ])
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$select1_ret") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "select1ret" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    0 []) CIType
    CIStackFrame CIStatic
    forall a. Monoid a => a
    mempty)
                      (JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $
                        (JStgExpr
    r1 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr -> JStgExpr
    closureField1 JStgExpr
    r1)
                        JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> Int -> JStgStat
    adjSpN' Int
    1
                        JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> JStgExpr -> JStgStat
    returnS (FastString -> [JStgExpr] -> JStgExpr
    app FastString
    "h$ap_0_0_fast" [])
                      )
                 -- select second field of a two-field constructor
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$select2_e") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "select2" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    1 [JSRep
    PtrV]) CIType
    CIThunk CIStatic
    forall a. Monoid a => a
    mempty)
                      ((JStgExpr -> JSM JStgStat) -> JSM JStgStat
    forall t.
    (JVarMagic t, ToJExpr t) =>
    (t -> JSM JStgStat) -> JSM JStgStat
    jVar \JStgExpr
    t -> JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $
                               [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat [JStgExpr
    t JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr -> JStgExpr
    closureField1 JStgExpr
    r1
                                       , Int -> JStgStat
    adjSp' Int
    3
                                       , JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! (JStgExpr
    sp JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    - JStgExpr
    2) JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    r1
                                       , JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! (JStgExpr
    sp JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    - JStgExpr
    1) JStgExpr -> JStgExpr -> JStgStat
    |= FastString -> JStgExpr
    var FastString
    "h$upd_frame"
                                       , JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    sp JStgExpr -> JStgExpr -> JStgStat
    |= FastString -> JStgExpr
    var FastString
    "h$select2_ret"
                                       , JStgExpr -> JStgExpr
    closureEntry  JStgExpr
    r1 JStgExpr -> JStgExpr -> JStgStat
    |= FastString -> JStgExpr
    var FastString
    "h$blackhole"
                                       , JStgExpr -> JStgExpr
    closureField1 JStgExpr
    r1 JStgExpr -> JStgExpr -> JStgStat
    |= FastString -> JStgExpr
    var FastString
    "h$currentThread"
                                       , JStgExpr -> JStgExpr
    closureField2 JStgExpr
    r1 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    null_
                                       , JStgExpr
    r1 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    t
                                       , JStgExpr -> JStgStat
    returnS (FastString -> [JStgExpr] -> JStgExpr
    app FastString
    "h$ap_0_0_fast" [])
                                       ]
                      )
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$select2_ret") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "select2ret" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    0 []) CIType
    CIStackFrame CIStatic
    forall a. Monoid a => a
    mempty)
                               (JSM JStgStat -> JSM JStgStat) -> JSM JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat [ JStgExpr
    r1 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr -> JStgExpr
    closureField2 JStgExpr
    r1
                                                  , Int -> JStgStat
    adjSpN' Int
    1
                                                  , JStgExpr -> JStgStat
    returnS (FastString -> [JStgExpr] -> JStgExpr
    app FastString
    "h$ap_0_0_fast" [])
                                                  ]
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$keepAlive_e") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "keepAlive" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    1 [JSRep
    PtrV]) CIType
    CIStackFrame CIStatic
    forall a. Monoid a => a
    mempty)
                           (JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat [ Int -> JStgStat
    adjSpN' Int
    2
                                             , JStgExpr -> JStgStat
    returnS (JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    sp)
                                             ]
                           )
                 -- a thunk that just raises a synchronous exception
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$raise_e") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "h$raise_e" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    0 []) CIType
    CIThunk CIStatic
    forall a. Monoid a => a
    mempty)
                      (JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ JStgExpr -> JStgStat
    returnS (FastString -> [JStgExpr] -> JStgExpr
    app FastString
    "h$throw" [JStgExpr -> JStgExpr
    closureField1 JStgExpr
    r1, JStgExpr
    false_]))
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$raiseAsync_e") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "h$raiseAsync_e" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    0 []) CIType
    CIThunk CIStatic
    forall a. Monoid a => a
    mempty)
                      (JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ JStgExpr -> JStgStat
    returnS  (FastString -> [JStgExpr] -> JStgExpr
    app FastString
    "h$throw" [JStgExpr -> JStgExpr
    closureField1 JStgExpr
    r1, JStgExpr
    true_]))
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$raiseAsync_frame") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 []) FastString
    "h$raiseAsync_frame" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    1 []) CIType
    CIStackFrame CIStatic
    forall a. Monoid a => a
    mempty)
                      ((JStgExpr -> JSM JStgStat) -> JSM JStgStat
    forall t.
    (JVarMagic t, ToJExpr t) =>
    (t -> JSM JStgStat) -> JSM JStgStat
    jVar \JStgExpr
    ex -> JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat [ JStgExpr
    ex JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! (JStgExpr
    sp JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    - JStgExpr
    1)
                                                    , Int -> JStgStat
    adjSpN' Int
    2
                                                    , JStgExpr -> JStgStat
    returnS (FastString -> [JStgExpr] -> JStgExpr
    app FastString
    "h$throw" [JStgExpr
    ex, JStgExpr
    true_])
                                                    ])
                 {- reduce result if it's a thunk, follow if it's an ind
                    add this to the stack if you want the outermost result
                    to always be reduced to whnf, and not an ind
                 -}
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$reduce") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "h$reduce" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    0 []) CIType
    CIStackFrame CIStatic
    forall a. Monoid a => a
    mempty)
                      (JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $
                        JStgExpr -> JStgStat -> JStgStat -> JStgStat
    ifS (JStgExpr -> JStgExpr
    isThunk JStgExpr
    r1)
                           (JStgExpr -> JStgStat
    returnS (JStgExpr
    r1 JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "f"))
                           (Int -> JStgStat
    adjSpN' Int
    1 JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> JStgExpr -> JStgStat
    returnS (JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    sp))
                      )
                 , StgToJSConfig -> JSM JStgStat
    rtsApply StgToJSConfig
    s
                 , JSM JStgStat
    closureTypes
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$runio_e") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "runio" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    1 [JSRep
    PtrV]) CIType
    CIThunk CIStatic
    forall a. Monoid a => a
    mempty)
                               (JSM JStgStat -> JSM JStgStat) -> JSM JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat [ JStgExpr
    r1 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr -> JStgExpr
    closureField1 JStgExpr
    r1
                                                  , JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr -> JStgExpr
    PreInc JStgExpr
    sp JStgExpr -> JStgExpr -> JStgStat
    |= FastString -> JStgExpr
    var FastString
    "h$ap_1_0"
                                                  , JStgExpr -> JStgStat
    returnS (FastString -> JStgExpr
    var FastString
    "h$ap_1_0")
                                                  ]
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$flushStdout_e") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 []) FastString
    "flushStdout" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    0 []) CIType
    CIThunk CIStatic
    forall a. Monoid a => a
    mempty)
                   (JSM JStgStat -> JSM JStgStat) -> JSM JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat [ JStgExpr
    r1 JStgExpr -> JStgExpr -> JStgStat
    |= FastString -> JStgExpr
    var FastString
    "h$ghczminternalZCGHCziInternalziIOziHandlezihFlush"
                                      , JStgExpr
    r2 JStgExpr -> JStgExpr -> JStgStat
    |= FastString -> JStgExpr
    var FastString
    "h$ghczminternalZCGHCziInternalziIOziHandleziFDzistdout"
                                      , JStgExpr -> JStgStat
    returnS (FastString -> [JStgExpr] -> JStgExpr
    app FastString
    "h$ap_1_1_fast" [])
                                      ]
                 , JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ FastString -> Ident
    global FastString
    "h$flushStdout" Ident -> JStgExpr -> JStgStat
    ||= FastString -> [JStgExpr] -> JStgExpr
    app FastString
    "h$static_thunk" [FastString -> JStgExpr
    var FastString
    "h$flushStdout_e"]
                 -- the scheduler pushes this frame when suspending a thread that
                 -- has not called h$reschedule explicitly
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$restoreThread") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 []) FastString
    "restoreThread" CILayout
    CILayoutVariable CIType
    CIStackFrame CIStatic
    forall a. Monoid a => a
    mempty)
                   (((JStgExpr, JStgExpr, JStgExpr) -> JSM JStgStat) -> JSM JStgStat
    forall args.
    JSArgument args =>
    (args -> JSM JStgStat) -> JSM JStgStat
    jVars \(JStgExpr
    f,JStgExpr
    frameSize,JStgExpr
    nregs) ->
                          do set_regs <- JStgExpr
    -> (JStgExpr -> JStgExpr)
    -> (JStgExpr -> JSM JStgStat)
    -> JSM JStgStat
    loop JStgExpr
    1 (JStgExpr -> JStgExpr -> JStgExpr
    .<=. JStgExpr
    nregs)
                                         (\JStgExpr
    i -> JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$setReg" [JStgExpr
    i, JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! (JStgExpr
    sp JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    - JStgExpr
    2 JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    - JStgExpr
    i)] JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> JStgExpr -> JStgStat
    postIncrS JStgExpr
    i)
                             return $ mconcat [f |= stack .! (sp - 2)
                                              , frameSize |= stack .! (sp - 1)
                                              , nregs |= frameSize - 3
                                              , set_regs
                                              , sp |= sp - frameSize
                                              , returnS f
                                              ])
                 -- return a closure in the stack frame to the next thing on the stack
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$return") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 []) FastString
    "return" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    1 [JSRep
    PtrV]) CIType
    CIStackFrame CIStatic
    forall a. Monoid a => a
    mempty)
                       (JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $
                         (JStgExpr
    r1 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! (JStgExpr
    sp JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    - JStgExpr
    1))
                         JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> Int -> JStgStat
    adjSpN' Int
    2
                         JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> JStgExpr -> JStgStat
    returnS (JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    sp))
                 --  return a function in the stack frame for the next call
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$returnf") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "returnf" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    1 [JSRep
    ObjV]) CIType
    CIStackFrame CIStatic
    forall a. Monoid a => a
    mempty)
                       ((JStgExpr -> JSM JStgStat) -> JSM JStgStat
    forall t.
    (JVarMagic t, ToJExpr t) =>
    (t -> JSM JStgStat) -> JSM JStgStat
    jVar \JStgExpr
    r -> JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $
                                   [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat [ JStgExpr
    r JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! (JStgExpr
    sp JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    - JStgExpr
    1)
                                           , Int -> JStgStat
    adjSpN' Int
    2
                                           , JStgExpr -> JStgStat
    returnS JStgExpr
    r
                                           ])
                 -- return this function when the scheduler needs to come into action
                 -- (yield, delay etc), returning thread needs to push all relevant
                 -- registers to stack frame, thread will be resumed by calling the stack top
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$reschedule") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 []) FastString
    "reschedule" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    0 []) CIType
    CIThunk CIStatic
    forall a. Monoid a => a
    mempty)
                       (JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ JStgExpr -> JStgStat
    returnS (JStgExpr -> JStgStat) -> JStgExpr -> JStgStat
    forall a b. (a -> b) -> a -> b
    $ FastString -> JStgExpr
    var FastString
    "h$reschedule")
                 -- debug thing, insert on stack to dump current result, should be boxed
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$dumpRes") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "dumpRes" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    1 [JSRep
    ObjV]) CIType
    CIThunk CIStatic
    forall a. Monoid a => a
    mempty)
                    ((JStgExpr -> JSM JStgStat) -> JSM JStgStat
    forall t.
    (JVarMagic t, ToJExpr t) =>
    (t -> JSM JStgStat) -> JSM JStgStat
    jVar \JStgExpr
    re -> JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $
                         [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat [ FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$log" [FastString -> JStgExpr
    jString FastString
    "h$dumpRes result: " JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    + JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! (JStgExpr
    spJStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    -JStgExpr
    1)]
                                 , FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$log" [JStgExpr
    r1]
                                 , FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$log" [FastString -> [JStgExpr] -> JStgExpr
    app FastString
    "h$collectProps" [JStgExpr
    r1]]
                                 , JStgExpr -> JStgStat -> JStgStat
    jwhenS ((JStgExpr
    r1 JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "f") JStgExpr -> JStgExpr -> JStgExpr
    .&&. (JStgExpr
    r1 JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "f" JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "n"))
                                   (FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$log" [FastString -> JStgExpr
    jString FastString
    "name: " JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    + JStgExpr
    r1 JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "f" JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "n"])
                                 , JStgExpr -> JStgStat -> JStgStat
    jwhenS (JStgExpr -> [JStgExpr] -> JStgExpr
    ApplExpr (JStgExpr
    r1 JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "hasOwnProperty") [FastString -> JStgExpr
    jString FastString
    closureField1_])
                                   (FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$log" [FastString -> JStgExpr
    jString FastString
    "d1: " JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    + JStgExpr -> JStgExpr
    closureField1 JStgExpr
    r1])
                                 , JStgExpr -> JStgStat -> JStgStat
    jwhenS (JStgExpr -> [JStgExpr] -> JStgExpr
    ApplExpr (JStgExpr
    r1 JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "hasOwnProperty") [FastString -> JStgExpr
    jString FastString
    closureField2_])
                                   (FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$log" [FastString -> JStgExpr
    jString FastString
    "d2: " JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    + JStgExpr -> JStgExpr
    closureField2 JStgExpr
    r1])
                                 , JStgExpr -> JStgStat -> JStgStat
    jwhenS (JStgExpr
    r1 JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "f") (JStgStat -> JStgStat) -> JStgStat -> JStgStat
    forall a b. (a -> b) -> a -> b
    $ [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat
                                   [ JStgExpr
    re JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr -> JStgExpr
    New (FastString -> [JStgExpr] -> JStgExpr
    app FastString
    "RegExp" [FastString -> JStgExpr
    jString FastString
    "([^\\n]+)\\n(.|\\n)*"])
                                   , FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$log" [FastString -> JStgExpr
    jString FastString
    "function"
                                                    JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    + JStgExpr -> [JStgExpr] -> JStgExpr
    ApplExpr (JStgExpr -> [JStgExpr] -> JStgExpr
    ApplExpr ((FastString -> JStgExpr
    jString FastString
    "" JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    + JStgExpr
    r1 JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "f") JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "substring") [JStgExpr
    0, JStgExpr
    50] JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "replace") [JStgExpr
    r1, FastString -> JStgExpr
    jString FastString
    "$1"]]
                                   ]
                                 , Int -> JStgStat
    adjSpN' Int
    2
                                 , JStgExpr
    r1 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    null_
                                 , JStgExpr -> JStgStat
    returnS (JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    sp)
                                 ])
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$resume_e") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "resume" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    0 []) CIType
    CIThunk CIStatic
    forall a. Monoid a => a
    mempty)
                         ((JStgExpr -> JSM JStgStat) -> JSM JStgStat
    forall t.
    (JVarMagic t, ToJExpr t) =>
    (t -> JSM JStgStat) -> JSM JStgStat
    jVar \JStgExpr
    ss ->
                            do update_stk <- JStgExpr
    -> (JStgExpr -> JStgExpr)
    -> (JStgExpr -> JSM JStgStat)
    -> JSM JStgStat
    loop JStgExpr
    0 (JStgExpr -> JStgExpr -> JStgExpr
    .<. JStgExpr
    ss JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "length") (\JStgExpr
    i -> JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ (JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! (JStgExpr
    spJStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    +JStgExpr
    1JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    +JStgExpr
    i) JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    ss JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    i) JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> JStgExpr -> JStgStat
    postIncrS JStgExpr
    i)
                               return $ mconcat [ss |= closureField1 r1
                                                , updateThunk' s
                                                , update_stk
                                                , sp |= sp + ss .^ "length"
                                                , r1 |= null_
                                                , returnS (stack .! sp)
                                                ])
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$unmaskFrame") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "unmask" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    0 []) CIType
    CIStackFrame CIStatic
    forall a. Monoid a => a
    mempty)
                      (JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $
                        (FastString -> JStgExpr
    var FastString
    "h$currentThread" JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "mask" JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    0)
                        JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> Int -> JStgStat
    adjSpN' Int
    1
                        -- back to scheduler to give us async exception if pending
                        JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> JStgExpr -> JStgStat -> JStgStat -> JStgStat
    ifS (FastString -> JStgExpr
    var FastString
    "h$currentThread" JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "excep" JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "length" JStgExpr -> JStgExpr -> JStgExpr
    .>. JStgExpr
    0)
                        (StgToJSConfig -> [JStgExpr] -> JStgStat
    push' StgToJSConfig
    s [JStgExpr
    r1, FastString -> JStgExpr
    var FastString
    "h$return"] JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> JStgExpr -> JStgStat
    returnS (FastString -> JStgExpr
    var FastString
    "h$reschedule"))
                        (JStgExpr -> JStgStat
    returnS (JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    sp)))
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$maskFrame") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "mask" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    0 []) CIType
    CIStackFrame CIStatic
    forall a. Monoid a => a
    mempty)
                   (JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $
                     (FastString -> JStgExpr
    var FastString
    "h$currentThread" JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "mask" JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    2)
                     JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> Int -> JStgStat
    adjSpN' Int
    1
                     JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> JStgExpr -> JStgStat
    returnS (JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    sp))
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$maskUnintFrame") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "maskUnint" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    0 []) CIType
    CIStackFrame CIStatic
    forall a. Monoid a => a
    mempty)
                   (JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $
                     (FastString -> JStgExpr
    var FastString
    "h$currentThread" JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "mask" JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    1)
                     JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> Int -> JStgStat
    adjSpN' Int
    1
                     JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> JStgExpr -> JStgStat
    returnS (JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    sp))
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$unboxFFIResult") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "unboxFFI" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    0 []) CIType
    CIStackFrame CIStatic
    forall a. Monoid a => a
    mempty)
                      ((JStgExpr -> JSM JStgStat) -> JSM JStgStat
    forall t.
    (JVarMagic t, ToJExpr t) =>
    (t -> JSM JStgStat) -> JSM JStgStat
    jVar \JStgExpr
    d -> do set_regs <- JStgExpr
    -> (JStgExpr -> JStgExpr)
    -> (JStgExpr -> JSM JStgStat)
    -> JSM JStgStat
    loop JStgExpr
    0 (JStgExpr -> JStgExpr -> JStgExpr
    .<. JStgExpr
    d JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "length") (\JStgExpr
    i -> JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$setReg" [JStgExpr
    i JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    + JStgExpr
    1, JStgExpr
    d JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    i] JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> JStgExpr -> JStgStat
    postIncrS JStgExpr
    i)
                                     return $ mconcat [ d |= closureField1 r1
                                                      , set_regs
                                                      , adjSpN' 1
                                                      , returnS (stack .! sp)
                                                      ])
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$unbox_e") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "unboxed value" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    1 [JSRep
    DoubleV]) CIType
    CIThunk CIStatic
    forall a. Monoid a => a
    mempty)
                      (JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ (JStgExpr
    r1 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr -> JStgExpr
    closureField1 JStgExpr
    r1) JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> JStgExpr -> JStgStat
    returnS (JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    sp))
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$retryInterrupted") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    ObjV]) FastString
    "retry interrupted operation" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    1 [JSRep
    ObjV]) CIType
    CIStackFrame CIStatic
    forall a. Monoid a => a
    mempty)
                      ((JStgExpr -> JSM JStgStat) -> JSM JStgStat
    forall t.
    (JVarMagic t, ToJExpr t) =>
    (t -> JSM JStgStat) -> JSM JStgStat
    jVar \JStgExpr
    a -> JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat [ JStgExpr
    a JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! (JStgExpr
    sp JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    - JStgExpr
    1)
                                                   , Int -> JStgStat
    adjSpN' Int
    2
                                                   , JStgExpr -> JStgStat
    returnS (JStgExpr -> [JStgExpr] -> JStgExpr
    ApplExpr (JStgExpr
    a JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    0 JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "apply") [FastString -> JStgExpr
    var FastString
    "this", JStgExpr -> [JStgExpr] -> JStgExpr
    ApplExpr (JStgExpr
    a JStgExpr -> FastString -> JStgExpr
    .^ FastString
    "slice") [JStgExpr
    1]])
                                                   ])
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$atomically_e") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "atomic operation" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    1 [JSRep
    PtrV]) CIType
    CIStackFrame CIStatic
    forall a. Monoid a => a
    mempty)
                      (JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ JStgExpr -> JStgStat -> JStgStat -> JStgStat
    ifS (FastString -> [JStgExpr] -> JStgExpr
    app FastString
    "h$stmValidateTransaction" [])
                   (FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$stmCommitTransaction" []
                            JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> Int -> JStgStat
    adjSpN' Int
    2
                            JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> JStgExpr -> JStgStat
    returnS (JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    sp))
                           (JStgExpr -> JStgStat
    returnS (FastString -> [JStgExpr] -> JStgExpr
    app FastString
    "h$stmStartTransaction" [JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! (JStgExpr
    sp JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    - JStgExpr
    1)])))

                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$stmCatchRetry_e") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "catch retry" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    1 [JSRep
    PtrV]) CIType
    CIStackFrame CIStatic
    forall a. Monoid a => a
    mempty)
                               (JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $
                                 Int -> JStgStat
    adjSpN' Int
    2
                                 JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$stmCommitTransaction" []
                                 JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> JStgExpr -> JStgStat
    returnS (JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    sp))
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$catchStm_e") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "STM catch" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    3 [JSRep
    ObjV,JSRep
    PtrV,JSRep
    ObjV]) CIType
    CIStackFrame CIStatic
    forall a. Monoid a => a
    mempty)
                   (JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $
                     Int -> JStgStat
    adjSpN' Int
    4
                     JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$stmCommitTransaction" []
                     JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> JStgExpr -> JStgStat
    returnS (JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    sp))
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$stmResumeRetry_e") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "resume retry" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    0 []) CIType
    CIStackFrame CIStatic
    forall a. Monoid a => a
    mempty)
                               ((JStgExpr -> JSM JStgStat) -> JSM JStgStat
    forall t.
    (JVarMagic t, ToJExpr t) =>
    (t -> JSM JStgStat) -> JSM JStgStat
    jVar \JStgExpr
    blocked ->
                                  JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $
                                   [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat [ JStgExpr -> JStgStat -> JStgStat
    jwhenS (JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! (JStgExpr
    sp JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    - JStgExpr
    2) JStgExpr -> JStgExpr -> JStgExpr
    .!==. FastString -> JStgExpr
    var FastString
    "h$atomically_e")
                                                        (FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "throw" [FastString -> JStgExpr
    jString FastString
    "h$stmResumeRetry_e: unexpected value on stack"])
                                           , JStgExpr
    blocked JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! (JStgExpr
    sp JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    - JStgExpr
    1)
                                           , Int -> JStgStat
    adjSpN' Int
    2
                                           , FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$stmRemoveBlockedThread" [JStgExpr
    blocked, FastString -> JStgExpr
    var FastString
    "h$currentThread"]
                                           , JStgExpr -> JStgStat
    returnS (FastString -> [JStgExpr] -> JStgExpr
    app FastString
    "h$stmStartTransaction" [JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! (JStgExpr
    sp JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    - JStgExpr
    1)])
                                           ])
                 , ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$lazy_e") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "generic lazy value" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    0 []) CIType
    CIThunk CIStatic
    forall a. Monoid a => a
    mempty)
                               ((JStgExpr -> JSM JStgStat) -> JSM JStgStat
    forall t.
    (JVarMagic t, ToJExpr t) =>
    (t -> JSM JStgStat) -> JSM JStgStat
    jVar \JStgExpr
    x ->
                                  JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $
                                   [JStgStat] -> JStgStat
    forall a. Monoid a => [a] -> a
    mconcat [JStgExpr
    x JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr -> [JStgExpr] -> JStgExpr
    ApplExpr (JStgExpr -> JStgExpr
    closureField1 JStgExpr
    r1) []
                                           , FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$bh" []
                                           , StgToJSConfig -> JStgStat -> JStgStat
    profStat StgToJSConfig
    s JStgStat
    enterCostCentreThunk
                                           , JStgExpr
    r1 JStgExpr -> JStgExpr -> JStgStat
    |= JStgExpr
    x
                                           , JStgExpr -> JStgStat
    returnS (JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    sp)
                                           ])
                 -- Top-level statements to generate only in profiling mode
                 , (JStgStat -> JStgStat) -> JSM JStgStat -> JSM JStgStat
    forall a b.
    (a -> b) -> StateT JEnv Identity a -> StateT JEnv Identity b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (StgToJSConfig -> JStgStat -> JStgStat
    profStat StgToJSConfig
    s) (JSM JStgStat -> JSM JStgStat) -> JSM JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $ (ClosureInfo -> JSM JStgStat -> JSM JStgStat
    closure (Ident
    -> CIRegs
    -> FastString
    -> CILayout
    -> CIType
    -> CIStatic
    -> ClosureInfo
    ClosureInfo (FastString -> Ident
    global FastString
    "h$setCcs_e") (Int -> [JSRep] -> CIRegs
    CIRegs Int
    0 [JSRep
    PtrV]) FastString
    "set cost centre stack" (Int -> [JSRep] -> CILayout
    CILayoutFixed Int
    1 [JSRep
    ObjV]) CIType
    CIStackFrame CIStatic
    forall a. Monoid a => a
    mempty)
                               (JStgStat -> JSM JStgStat
    forall a. a -> StateT JEnv Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (JStgStat -> JSM JStgStat) -> JStgStat -> JSM JStgStat
    forall a b. (a -> b) -> a -> b
    $
                                 FastString -> [JStgExpr] -> JStgStat
    appS FastString
    "h$restoreCCS" [ JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! (JStgExpr
    sp JStgExpr -> JStgExpr -> JStgExpr
    forall a. Num a => a -> a -> a
    - JStgExpr
    1)]
                                 JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> Int -> JStgStat
    adjSpN' Int
    2
                                 JStgStat -> JStgStat -> JStgStat
    forall a. Semigroup a => a -> a -> a
    <> JStgExpr -> JStgStat
    returnS (JStgExpr
    stack JStgExpr -> JStgExpr -> JStgExpr
    .! JStgExpr
    sp)))
                 ]