{-# LANGUAGE OverloadedStrings #-}

{-# OPTIONS_GHC -O0 #-}

-----------------------------------------------------------------------------
-- |
-- 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 where

import GHC.Prelude

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

import GHC.StgToJS.Apply
import GHC.StgToJS.Closure
import GHC.StgToJS.Heap
import GHC.StgToJS.Printer
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 :: JStat
garbageCollector :: JStat
garbageCollector =
  forall a. Monoid a => [a] -> a
mconcat [ FastString -> Ident
TxtI FastString
"h$resetRegisters"  Ident -> JExpr -> JStat
||= forall a. ToSat a => a -> JExpr
jLam (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map StgReg -> JStat
resetRegister [forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound])
          , FastString -> Ident
TxtI FastString
"h$resetResultVars" Ident -> JExpr -> JStat
||= forall a. ToSat a => a -> JExpr
jLam (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map StgRet -> JStat
resetResultVar [forall a. Bounded a => a
minBound..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 -> JStat
resetRegister :: StgReg -> JStat
resetRegister StgReg
r = forall a. ToJExpr a => a -> JExpr
toJExpr StgReg
r JExpr -> JExpr -> JStat
|= JExpr
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 -> JStat
resetResultVar :: StgRet -> JStat
resetResultVar StgRet
r = forall a. ToJExpr a => a -> JExpr
toJExpr StgRet
r JExpr -> JExpr -> JStat
|= JExpr
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 -> JStat
closureConstructors :: StgToJSConfig -> JStat
closureConstructors StgToJSConfig
s = [JStat] -> JStat
BlockStat
  [ FastString -> [FastString] -> Closure -> JStat
declClsConstr FastString
"h$c" [FastString
"f"] forall a b. (a -> b) -> a -> b
$ Closure
      { clEntry :: JExpr
clEntry  = FastString -> JExpr
var FastString
"f"
      , clField1 :: JExpr
clField1 = JExpr
null_
      , clField2 :: JExpr
clField2 = JExpr
null_
      , clMeta :: JExpr
clMeta   = JExpr
0
      , clCC :: Maybe JExpr
clCC     = Maybe JExpr
ccVal
      }
  , FastString -> [FastString] -> Closure -> JStat
declClsConstr FastString
"h$c0" [FastString
"f"] forall a b. (a -> b) -> a -> b
$ Closure
      { clEntry :: JExpr
clEntry  = FastString -> JExpr
var FastString
"f"
      , clField1 :: JExpr
clField1 = JExpr
null_
      , clField2 :: JExpr
clField2 = JExpr
null_
      , clMeta :: JExpr
clMeta   = JExpr
0
      , clCC :: Maybe JExpr
clCC     = Maybe JExpr
ccVal
      }
  , FastString -> [FastString] -> Closure -> JStat
declClsConstr FastString
"h$c1" [FastString
"f", FastString
"x1"] forall a b. (a -> b) -> a -> b
$ Closure
      { clEntry :: JExpr
clEntry  = FastString -> JExpr
var FastString
"f"
      , clField1 :: JExpr
clField1 = FastString -> JExpr
var FastString
"x1"
      , clField2 :: JExpr
clField2 = JExpr
null_
      , clMeta :: JExpr
clMeta   = JExpr
0
      , clCC :: Maybe JExpr
clCC     = Maybe JExpr
ccVal
      }
  , FastString -> [FastString] -> Closure -> JStat
declClsConstr FastString
"h$c2" [FastString
"f", FastString
"x1", FastString
"x2"] forall a b. (a -> b) -> a -> b
$ Closure
      { clEntry :: JExpr
clEntry  = FastString -> JExpr
var FastString
"f"
      , clField1 :: JExpr
clField1 = FastString -> JExpr
var FastString
"x1"
      , clField2 :: JExpr
clField2 = FastString -> JExpr
var FastString
"x2"
      , clMeta :: JExpr
clMeta   = JExpr
0
      , clCC :: Maybe JExpr
clCC     = Maybe JExpr
ccVal
      }
  , forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map Int -> JStat
mkClosureCon [Int
3..Int
24])
  , forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map Int -> JStat
mkDataFill [Int
1..Int
24])
  ]
  where
    prof :: Bool
prof = StgToJSConfig -> Bool
csProf StgToJSConfig
s
    ([Ident]
ccArg,Maybe JExpr
ccVal)
      -- the cc argument happens to be named just like the cc field...
      | Bool
prof      = ([FastString -> Ident
TxtI FastString
closureCC_], forall a. a -> Maybe a
Just (FastString -> JExpr
var FastString
closureCC_))
      | Bool
otherwise = ([], forall a. Maybe a
Nothing)
    addCCArg :: [FastString] -> [Ident]
addCCArg [FastString]
as = forall a b. (a -> b) -> [a] -> [b]
map FastString -> Ident
TxtI [FastString]
as forall a. [a] -> [a] -> [a]
++ [Ident]
ccArg
    addCCArg' :: [Ident] -> [Ident]
addCCArg' [Ident]
as = [Ident]
as forall a. [a] -> [a] -> [a]
++ [Ident]
ccArg

    declClsConstr :: FastString -> [FastString] -> Closure -> JStat
declClsConstr FastString
i [FastString]
as Closure
cl = FastString -> Ident
TxtI FastString
i Ident -> JExpr -> JStat
||= JVal -> JExpr
ValExpr ([Ident] -> JStat -> JVal
JFunc ([FastString] -> [Ident]
addCCArg [FastString]
as)
      ( forall a. ToSat a => a -> JStat
jVar forall a b. (a -> b) -> a -> b
$ \JExpr
x ->
          [ JStat
checkC
          , JExpr
x JExpr -> JExpr -> JStat
|= Closure -> JExpr
newClosure Closure
cl
          , JExpr -> JStat
notifyAlloc JExpr
x
          , JExpr -> JStat
traceAlloc JExpr
x
          , JExpr -> JStat
returnS JExpr
x
          ]
         ))

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

    notifyAlloc :: JExpr -> JStat
notifyAlloc JExpr
x | StgToJSConfig -> Bool
csDebugAlloc StgToJSConfig
s = FastString -> [JExpr] -> JStat
appS FastString
"h$debugAlloc_notifyAlloc" [JExpr
x]
                  | Bool
otherwise      = 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 :: JStat
    checkC :: JStat
checkC | StgToJSConfig -> Bool
csAssertRts StgToJSConfig
s =
      forall a. ToSat a => a -> JStat
jVar forall a b. (a -> b) -> a -> b
$ \JExpr
msg ->
      JExpr -> JStat -> JStat
jwhenS (FastString -> JExpr
var FastString
"arguments" JExpr -> JExpr -> JExpr
.! JExpr
0 JExpr -> JExpr -> JExpr
.!==. FastString -> JExpr
jString FastString
"h$baseZCGHCziJSziPrimziJSVal_con_e")
                                  (JExpr -> (JExpr -> JExpr) -> (JExpr -> JStat) -> JStat
loop JExpr
1 (JExpr -> JExpr -> JExpr
.<. FastString -> JExpr
var FastString
"arguments" JExpr -> FastString -> JExpr
.^ FastString
"length")
                                          (\JExpr
i ->
                                             forall a. Monoid a => [a] -> a
mconcat [JExpr
msg JExpr -> JExpr -> JStat
|= FastString -> JExpr
jString FastString
"warning: undefined or null in argument: "
                                                       forall a. Num a => a -> a -> a
+ JExpr
i
                                                       forall a. Num a => a -> a -> a
+ FastString -> JExpr
jString FastString
" allocating closure: " forall a. Num a => a -> a -> a
+ (FastString -> JExpr
var FastString
"arguments" JExpr -> JExpr -> JExpr
.! JExpr
0 JExpr -> FastString -> JExpr
.^ FastString
"n")
                                                     , FastString -> [JExpr] -> JStat
appS FastString
"h$log" [JExpr
msg]
                                                     , JExpr -> JStat -> JStat
jwhenS (FastString -> JExpr
var FastString
"console" JExpr -> JExpr -> JExpr
.&&. (FastString -> JExpr
var FastString
"console" JExpr -> FastString -> JExpr
.^ FastString
"trace")) ((FastString -> JExpr
var FastString
"console" JExpr -> FastString -> JExpr
.^ FastString
"trace") JExpr -> [JExpr] -> JStat
`ApplStat` [JExpr
msg])
                                                     , JExpr -> JStat
postIncrS JExpr
i
                                                     ])

                                  )
           | Bool
otherwise = 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 :: JStat
checkD | StgToJSConfig -> Bool
csAssertRts StgToJSConfig
s =
                     JExpr -> (JExpr -> JExpr) -> (JExpr -> JStat) -> JStat
loop JExpr
0 (JExpr -> JExpr -> JExpr
.<. FastString -> JExpr
var FastString
"arguments" JExpr -> FastString -> JExpr
.^ FastString
"length")
                     (\JExpr
i -> JExpr -> JStat -> JStat
jwhenS ((FastString -> JExpr
var FastString
"arguments" JExpr -> JExpr -> JExpr
.! JExpr
i JExpr -> JExpr -> JExpr
.===. JExpr
null_)
                                    JExpr -> JExpr -> JExpr
.||. (FastString -> JExpr
var FastString
"arguments" JExpr -> JExpr -> JExpr
.! JExpr
i JExpr -> JExpr -> JExpr
.===. JExpr
undefined_))
                            (forall a. ToSat a => a -> JStat
jVar forall a b. (a -> b) -> a -> b
$ \JExpr
msg ->
                                forall a. Monoid a => [a] -> a
mconcat [ JExpr
msg JExpr -> JExpr -> JStat
|= FastString -> JExpr
jString FastString
"warning: undefined or null in argument: " forall a. Num a => a -> a -> a
+ JExpr
i forall a. Num a => a -> a -> a
+ FastString -> JExpr
jString FastString
" allocating fields"
                                        , JExpr -> JStat -> JStat
jwhenS (FastString -> JExpr
var FastString
"console" JExpr -> JExpr -> JExpr
.&&. (FastString -> JExpr
var FastString
"console" JExpr -> FastString -> JExpr
.^ FastString
"trace"))
                                                ((FastString -> JExpr
var FastString
"console" JExpr -> FastString -> JExpr
.^ FastString
"trace") JExpr -> [JExpr] -> JStat
`ApplStat` [JExpr
msg])
                                        ]))

           | Bool
otherwise = forall a. Monoid a => a
mempty

    mkClosureCon :: Int -> JStat
    mkClosureCon :: Int -> JStat
mkClosureCon Int
n = Ident
funName Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr JVal
fun
      where
        funName :: Ident
funName = FastString -> Ident
TxtI forall a b. (a -> b) -> a -> b
$ String -> FastString
mkFastString (String
"h$c" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n)
        -- args are: f x1 x2 .. xn [cc]
        args :: [Ident]
args   = FastString -> Ident
TxtI FastString
"f" forall a. a -> [a] -> [a]
: [Ident] -> [Ident]
addCCArg' (forall a b. (a -> b) -> [a] -> [b]
map (FastString -> Ident
TxtI forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
mkFastString forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'x'forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) [(Int
1::Int)..Int
n])
        fun :: JVal
fun    = [Ident] -> JStat -> JVal
JFunc [Ident]
args JStat
funBod
        -- x1 goes into closureField1. All the other args are bundled into an
        -- object in closureField2: { d1 = x2, d2 = x3, ... }
        --
        extra_args :: JExpr
extra_args = JVal -> JExpr
ValExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqMap FastString JExpr -> JVal
JHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Uniquable k => [(k, a)] -> UniqMap k a
listToUniqMap forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip
                   (forall a b. (a -> b) -> [a] -> [b]
map (String -> FastString
mkFastString forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'd'forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) [(Int
1::Int)..])
                   (forall a b. (a -> b) -> [a] -> [b]
map (forall a. ToJExpr a => a -> JExpr
toJExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> Ident
TxtI forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
mkFastString forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'x'forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) [Int
2..Int
n])

        funBod :: JStat
funBod = forall a. ToSat a => a -> JStat
jVar forall a b. (a -> b) -> a -> b
$ \JExpr
x ->
            [ JStat
checkC
            , JExpr
x JExpr -> JExpr -> JStat
|= Closure -> JExpr
newClosure Closure
               { clEntry :: JExpr
clEntry  = FastString -> JExpr
var FastString
"f"
               , clField1 :: JExpr
clField1 = FastString -> JExpr
var FastString
"x1"
               , clField2 :: JExpr
clField2 = JExpr
extra_args
               , clMeta :: JExpr
clMeta   = JExpr
0
               , clCC :: Maybe JExpr
clCC     = Maybe JExpr
ccVal
               }
            , JExpr -> JStat
notifyAlloc JExpr
x
            , JExpr -> JStat
traceAlloc JExpr
x
            , JExpr -> JStat
returnS JExpr
x
            ]

    mkDataFill :: Int -> JStat
    mkDataFill :: Int -> JStat
mkDataFill Int
n = Ident
funName Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr JVal
fun
      where
        funName :: Ident
funName    = FastString -> Ident
TxtI forall a b. (a -> b) -> a -> b
$ String -> FastString
mkFastString (String
"h$d" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n)
        ds :: [FastString]
ds         = forall a b. (a -> b) -> [a] -> [b]
map (String -> FastString
mkFastString forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'd'forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) [(Int
1::Int)..Int
n]
        extra_args :: JExpr
extra_args = JVal -> JExpr
ValExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqMap FastString JExpr -> JVal
JHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Uniquable k => [(k, a)] -> UniqMap k a
listToUniqMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [FastString]
ds forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. ToJExpr a => a -> JExpr
toJExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> Ident
TxtI) [FastString]
ds
        fun :: JVal
fun        = [Ident] -> JStat -> JVal
JFunc (forall a b. (a -> b) -> [a] -> [b]
map FastString -> Ident
TxtI [FastString]
ds) (JStat
checkD forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS JExpr
extra_args)

-- | JS Payload to perform stack manipulation in the RTS
stackManip :: JStat
stackManip :: JStat
stackManip = forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map Int -> JStat
mkPush [Int
1..Int
32]) forall a. Semigroup a => a -> a -> a
<>
             forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map Integer -> JStat
mkPpush [Integer
1..Integer
255])
  where
    mkPush :: Int -> JStat
    mkPush :: Int -> JStat
mkPush Int
n = let funName :: Ident
funName = FastString -> Ident
TxtI forall a b. (a -> b) -> a -> b
$ String -> FastString
mkFastString (String
"h$p" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n)
                   as :: [Ident]
as      = forall a b. (a -> b) -> [a] -> [b]
map (FastString -> Ident
TxtI forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
mkFastString forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'x'forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) [Int
1..Int
n]
                   fun :: JVal
fun     = [Ident] -> JStat -> JVal
JFunc [Ident]
as ((JExpr
sp JExpr -> JExpr -> JStat
|= JExpr
sp forall a. Num a => a -> a -> a
+ forall a. ToJExpr a => a -> JExpr
toJExpr Int
n)
                                       forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i Ident
a -> JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp forall a. Num a => a -> a -> a
- forall a. ToJExpr a => a -> JExpr
toJExpr (Int
nforall a. Num a => a -> a -> a
-Int
i)) JExpr -> JExpr -> JStat
|= forall a. ToJExpr a => a -> JExpr
toJExpr Ident
a)
                                                   [Int
1..] [Ident]
as))
               in Ident
funName Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr JVal
fun

    -- partial pushes, based on bitmap, increases Sp by highest bit
    mkPpush :: Integer -> JStat
    mkPpush :: Integer -> JStat
mkPpush Integer
sig | Integer
sig forall a. Bits a => a -> a -> a
Bits..&. (Integer
sigforall a. Num a => a -> a -> a
+Integer
1) forall a. Eq a => a -> a -> Bool
== Integer
0 = forall a. Monoid a => a
mempty -- already handled by h$p
    mkPpush Integer
sig = let funName :: Ident
funName = FastString -> Ident
TxtI forall a b. (a -> b) -> a -> b
$ String -> FastString
mkFastString (String
"h$pp" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
sig)
                      bits :: [Int]
bits    = Integer -> [Int]
bitsIdx Integer
sig
                      n :: Int
n       = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
bits
                      h :: Int
h       = forall a. [a] -> a
last [Int]
bits
                      args :: [Ident]
args    = forall a b. (a -> b) -> [a] -> [b]
map (FastString -> Ident
TxtI forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
mkFastString forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'x'forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) [Int
1..Int
n]
                      fun :: JVal
fun     = [Ident] -> JStat -> JVal
JFunc [Ident]
args forall a b. (a -> b) -> a -> b
$
                        forall a. Monoid a => [a] -> a
mconcat [ JExpr
sp JExpr -> JExpr -> JStat
|= JExpr
sp forall a. Num a => a -> a -> a
+ forall a. ToJExpr a => a -> JExpr
toJExpr (Int
hforall a. Num a => a -> a -> a
+Int
1)
                                , forall a. Monoid a => [a] -> a
mconcat (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
b Ident
a -> JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp forall a. Num a => a -> a -> a
- forall a. ToJExpr a => a -> JExpr
toJExpr (Int
hforall a. Num a => a -> a -> a
-Int
b)) JExpr -> JExpr -> JStat
|= forall a. ToJExpr a => a -> JExpr
toJExpr Ident
a) [Int]
bits [Ident]
args)
                                ]
                   in Ident
funName Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr JVal
fun

bitsIdx :: Integer -> [Int]
bitsIdx :: Integer -> [Int]
bitsIdx Integer
n | Integer
n forall a. Ord a => a -> a -> Bool
< Integer
0 = forall a. HasCallStack => String -> a
error String
"bitsIdx: negative"
          | Bool
otherwise = 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 | forall a. Bits a => a -> Int -> Bool
Bits.testBit t
m Int
b = Int
b forall a. a -> [a] -> [a]
: t -> Int -> [Int]
go (forall a. Bits a => a -> Int -> a
Bits.clearBit t
m Int
b) (Int
bforall a. Num a => a -> a -> a
+Int
1)
           | Bool
otherwise   = t -> Int -> [Int]
go (forall a. Bits a => a -> Int -> a
Bits.clearBit t
m Int
b) (Int
bforall a. Num a => a -> a -> a
+Int
1)

bhLneStats :: StgToJSConfig -> JExpr -> JExpr -> JStat
bhLneStats :: StgToJSConfig -> JExpr -> JExpr -> JStat
bhLneStats StgToJSConfig
_s JExpr
p JExpr
frameSize =
   forall a. ToSat a => a -> JStat
jVar forall a b. (a -> b) -> a -> b
$ \JExpr
v ->
            forall a. Monoid a => [a] -> a
mconcat [ JExpr
v JExpr -> JExpr -> JStat
|= JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
p
                    , JExpr -> JStat -> JStat -> JStat
ifS JExpr
v
                      ((JExpr
sp JExpr -> JExpr -> JStat
|= JExpr
sp forall a. Num a => a -> a -> a
- JExpr
frameSize)
                       forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat -> JStat -> JStat
ifS (JExpr
v JExpr -> JExpr -> JExpr
.===. FastString -> JExpr
var FastString
"h$blackhole")
                                (JExpr -> JStat
returnS forall a b. (a -> b) -> a -> b
$ FastString -> [JExpr] -> JExpr
app FastString
"h$throw" [FastString -> JExpr
var FastString
"h$baseZCControlziExceptionziBasezinonTermination", JExpr
false_])
                                (forall a. Monoid a => [a] -> a
mconcat [JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr
v
                                         , JExpr
sp JExpr -> JExpr -> JStat
|= JExpr
sp forall a. Num a => a -> a -> a
- JExpr
frameSize
                                         , JStat
returnStack
                                         ]))
                      ((JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
p JExpr -> JExpr -> JStat
|= FastString -> JExpr
var FastString
"h$blackhole") forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS JExpr
null_)
                    ]


-- | JS payload to declare the registers
declRegs :: JStat
declRegs :: JStat
declRegs =
  forall a. Monoid a => [a] -> a
mconcat [ FastString -> Ident
TxtI FastString
"h$regs" Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr ([JExpr] -> JVal
JList [])
          , forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (Show a, ToJExpr a) => a -> JStat
declReg (forall a. Enum a => a -> a -> [a]
enumFromTo StgReg
R1 StgReg
R32))
          , JStat
regGettersSetters
          , JStat
loadRegs
          ]
    where
      declReg :: a -> JStat
declReg a
r = (Ident -> JStat
decl forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> Ident
TxtI forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
mkFastString forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"h$"forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) a
r
                  forall a. Semigroup a => a -> a -> a
<> [JStat] -> JStat
BlockStat [JExpr -> JExpr -> JStat
AssignStat (forall a. ToJExpr a => a -> JExpr
toJExpr a
r) (JVal -> JExpr
ValExpr (Integer -> JVal
JInt Integer
0))] -- [j| `r` = 0; |]

-- | JS payload to define getters and setters on the registers.
regGettersSetters :: JStat
regGettersSetters :: JStat
regGettersSetters =
  forall a. Monoid a => [a] -> a
mconcat [ FastString -> Ident
TxtI FastString
"h$getReg" Ident -> JExpr -> JStat
||= forall a. ToSat a => a -> JExpr
jLam (\JExpr
n   -> JExpr -> [(JExpr, JStat)] -> JStat -> JStat
SwitchStat JExpr
n [(JExpr, JStat)]
getRegCases forall a. Monoid a => a
mempty)
          , FastString -> Ident
TxtI FastString
"h$setReg" Ident -> JExpr -> JStat
||= forall a. ToSat a => a -> JExpr
jLam (\JExpr
n JExpr
v -> JExpr -> [(JExpr, JStat)] -> JStat -> JStat
SwitchStat JExpr
n (forall {a}. ToJExpr a => a -> [(JExpr, JStat)]
setRegCases JExpr
v) forall a. Monoid a => a
mempty)
          ]
  where
    getRegCases :: [(JExpr, JStat)]
getRegCases =
      forall a b. (a -> b) -> [a] -> [b]
map (\StgReg
r -> (forall a. ToJExpr a => a -> JExpr
toJExpr (StgReg -> Int
jsRegToInt StgReg
r) , JExpr -> JStat
returnS (forall a. ToJExpr a => a -> JExpr
toJExpr StgReg
r))) [StgReg]
regsFromR1
    setRegCases :: a -> [(JExpr, JStat)]
setRegCases a
v =
      forall a b. (a -> b) -> [a] -> [b]
map (\StgReg
r -> (forall a. ToJExpr a => a -> JExpr
toJExpr (StgReg -> Int
jsRegToInt StgReg
r), (forall a. ToJExpr a => a -> JExpr
toJExpr StgReg
r JExpr -> JExpr -> JStat
|= forall a. ToJExpr a => a -> JExpr
toJExpr a
v) forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS JExpr
undefined_)) [StgReg]
regsFromR1

-- | JS payload that defines the functions to load each register
loadRegs :: JStat
loadRegs :: JStat
loadRegs = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Int -> JStat
mkLoad [Int
1..Int
32]
  where
    mkLoad :: Int -> JStat
    mkLoad :: Int -> JStat
mkLoad Int
n = let args :: [Ident]
args   = forall a b. (a -> b) -> [a] -> [b]
map (FastString -> Ident
TxtI forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
mkFastString forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"x"forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) [Int
1..Int
n]
                   assign :: [JStat]
assign = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Ident
a StgReg
r -> forall a. ToJExpr a => a -> JExpr
toJExpr StgReg
r JExpr -> JExpr -> JStat
|= forall a. ToJExpr a => a -> JExpr
toJExpr Ident
a)
                              [Ident]
args (forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
n [StgReg]
regsFromR1)
                   fname :: Ident
fname  = FastString -> Ident
TxtI forall a b. (a -> b) -> a -> b
$ String -> FastString
mkFastString (String
"h$l" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n)
                   fun :: JVal
fun    = [Ident] -> JStat -> JVal
JFunc [Ident]
args (forall a. Monoid a => [a] -> a
mconcat [JStat]
assign)
               in Ident
fname Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr JVal
fun

-- | 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 -> [JExpr] -> JStat
assignRegs :: StgToJSConfig -> [JExpr] -> JStat
assignRegs StgToJSConfig
_ [] = forall a. Monoid a => a
mempty
assignRegs StgToJSConfig
s [JExpr]
xs
  | Int
l forall a. Ord a => a -> a -> Bool
<= Int
32 Bool -> Bool -> Bool
&& Bool -> Bool
not (StgToJSConfig -> Bool
csInlineLoadRegs StgToJSConfig
s)
      = JExpr -> [JExpr] -> JStat
ApplStat (JVal -> JExpr
ValExpr (Ident -> JVal
JVar forall a b. (a -> b) -> a -> b
$ Array Int Ident
assignRegs'forall i e. Ix i => Array i e -> i -> e
!Int
l)) (forall a. [a] -> [a]
reverse [JExpr]
xs)
  | Bool
otherwise = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$
      forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\StgReg
r JExpr
ex -> forall a. ToJExpr a => a -> JExpr
toJExpr StgReg
r JExpr -> JExpr -> JStat
|= JExpr
ex) (forall a. Int -> [a] -> [a]
take Int
l [StgReg]
regsFromR1) [JExpr]
xs
  where
    l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length [JExpr]
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' = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
1,Int
32) (forall a b. (a -> b) -> [a] -> [b]
map (FastString -> Ident
TxtI forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
mkFastString forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"h$l"forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) [(Int
1::Int)..Int
32])

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

-- | JS payload defining the types closures.
closureTypes :: JStat
closureTypes :: JStat
closureTypes = forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map ClosureType -> JStat
mkClosureType (forall a. Enum a => a -> a -> [a]
enumFromTo forall a. Bounded a => a
minBound forall a. Bounded a => a
maxBound)) forall a. Semigroup a => a -> a -> a
<> JStat
closureTypeName
  where
    mkClosureType :: ClosureType -> JStat
    mkClosureType :: ClosureType -> JStat
mkClosureType ClosureType
c = let s :: Ident
s = FastString -> Ident
TxtI forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
mkFastString forall a b. (a -> b) -> a -> b
$ String
"h$" forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (forall a. Show a => a -> String
show ClosureType
c) forall a. [a] -> [a] -> [a]
++ String
"_CLOSURE"
                      in  Ident
s Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr ClosureType
c
    closureTypeName :: JStat
    closureTypeName :: JStat
closureTypeName =
      FastString -> Ident
TxtI FastString
"h$closureTypeName" Ident -> JExpr -> JStat
||= forall a. ToSat a => a -> JExpr
jLam (\JExpr
c ->
                                           forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (JExpr -> ClosureType -> JStat
ifCT JExpr
c) [forall a. Bounded a => a
minBound..forall a. Bounded a => a
maxBound])
                                          forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS (FastString -> JExpr
jString FastString
"InvalidClosureType"))

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

-- | JS payload declaring the RTS functions.
rtsDecls :: JStat
rtsDecls :: JStat
rtsDecls = forall a. JMacro a => Maybe FastString -> a -> a
jsSaturate (forall a. a -> Maybe a
Just FastString
"h$RTSD") forall a b. (a -> b) -> a -> b
$
  forall a. Monoid a => [a] -> a
mconcat [ FastString -> Ident
TxtI FastString
"h$currentThread"   Ident -> JExpr -> JStat
||= JExpr
null_                   -- thread state object for current thread
          , FastString -> Ident
TxtI FastString
"h$stack"           Ident -> JExpr -> JStat
||= JExpr
null_                   -- stack for the current thread
          , FastString -> Ident
TxtI FastString
"h$sp"              Ident -> JExpr -> JStat
||= JExpr
0                       -- stack pointer for the current thread
          , FastString -> Ident
TxtI FastString
"h$initStatic"      Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr ([JExpr] -> JVal
JList [])      -- we need delayed initialization for static objects, push functions here to be initialized just before haskell runs
          , FastString -> Ident
TxtI FastString
"h$staticThunks"    Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr ([(FastString, JExpr)] -> JVal
jhFromList []) --  funcName -> heapidx map for srefs
          , FastString -> Ident
TxtI FastString
"h$staticThunksArr" Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr ([JExpr] -> JVal
JList [])      -- indices of updatable thunks in static heap
          , FastString -> Ident
TxtI FastString
"h$CAFs"            Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr ([JExpr] -> JVal
JList [])
          , FastString -> Ident
TxtI FastString
"h$CAFsReset"       Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr ([JExpr] -> JVal
JList [])
          -- stg registers
          , JStat
declRegs
          , JStat
declRets]

-- | print the embedded RTS to a String
rtsText :: StgToJSConfig -> String
rtsText :: StgToJSConfig -> String
rtsText = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. JStat -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. StgToJSConfig -> JStat
rts

-- | print the RTS declarations to a String.
rtsDeclsText :: String
rtsDeclsText :: String
rtsDeclsText = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. JStat -> Doc
pretty forall a b. (a -> b) -> a -> b
$ JStat
rtsDecls

-- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform'
rts :: StgToJSConfig -> JStat
rts :: StgToJSConfig -> JStat
rts = forall a. JMacro a => Maybe FastString -> a -> a
jsSaturate (forall a. a -> Maybe a
Just FastString
"h$RTS") forall b c a. (b -> c) -> (a -> b) -> a -> c
. StgToJSConfig -> JStat
rts'

-- | JS Payload which defines the embedded RTS.
rts' :: StgToJSConfig -> JStat
rts' :: StgToJSConfig -> JStat
rts' StgToJSConfig
s =
  forall a. Monoid a => [a] -> a
mconcat [ StgToJSConfig -> JStat
closureConstructors StgToJSConfig
s
          , JStat
garbageCollector
          , JStat
stackManip
          , FastString -> Ident
TxtI FastString
"h$rts_traceForeign" Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr (StgToJSConfig -> Bool
csTraceForeign StgToJSConfig
s)
          , FastString -> Ident
TxtI FastString
"h$rts_profiling"    Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr (StgToJSConfig -> Bool
csProf StgToJSConfig
s)
          , FastString -> Ident
TxtI FastString
"h$ct_fun"        Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr ClosureType
Fun
          , FastString -> Ident
TxtI FastString
"h$ct_con"        Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr ClosureType
Con
          , FastString -> Ident
TxtI FastString
"h$ct_thunk"      Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr ClosureType
Thunk
          , FastString -> Ident
TxtI FastString
"h$ct_pap"        Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr ClosureType
Pap
          , FastString -> Ident
TxtI FastString
"h$ct_blackhole"  Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr ClosureType
Blackhole
          , FastString -> Ident
TxtI FastString
"h$ct_stackframe" Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr ClosureType
StackFrame
          , FastString -> Ident
TxtI FastString
"h$vt_ptr"    Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr VarType
PtrV
          , FastString -> Ident
TxtI FastString
"h$vt_void"   Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr VarType
VoidV
          , FastString -> Ident
TxtI FastString
"h$vt_double" Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr VarType
IntV
          , FastString -> Ident
TxtI FastString
"h$vt_long"   Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr VarType
LongV
          , FastString -> Ident
TxtI FastString
"h$vt_addr"   Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr VarType
AddrV
          , FastString -> Ident
TxtI FastString
"h$vt_rtsobj" Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr VarType
RtsObjV
          , FastString -> Ident
TxtI FastString
"h$vt_obj"    Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr VarType
ObjV
          , FastString -> Ident
TxtI FastString
"h$vt_arr"    Ident -> JExpr -> JStat
||= forall a. ToJExpr a => a -> JExpr
toJExpr VarType
ArrV
          , FastString -> Ident
TxtI FastString
"h$bh"        Ident -> JExpr -> JStat
||= forall a. ToSat a => a -> JExpr
jLam (StgToJSConfig -> Bool -> JStat
bhStats StgToJSConfig
s Bool
True)
          , FastString -> Ident
TxtI FastString
"h$bh_lne"    Ident -> JExpr -> JStat
||= forall a. ToSat a => a -> JExpr
jLam (\JExpr
x JExpr
frameSize -> StgToJSConfig -> JExpr -> JExpr -> JStat
bhLneStats StgToJSConfig
s JExpr
x JExpr
frameSize)
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$blackhole") (Int -> [VarType] -> CIRegs
CIRegs Int
0 []) FastString
"blackhole" (Int -> CILayout
CILayoutUnknown Int
2) CIType
CIBlackhole forall a. Monoid a => a
mempty)
               (FastString -> [JExpr] -> JStat
appS FastString
"throw" [FastString -> JExpr
jString FastString
"oops: entered black hole"])
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$blackholeTrap") (Int -> [VarType] -> CIRegs
CIRegs Int
0 []) FastString
"blackhole" (Int -> CILayout
CILayoutUnknown Int
2) CIType
CIThunk forall a. Monoid a => a
mempty)
               (FastString -> [JExpr] -> JStat
appS FastString
"throw" [FastString -> JExpr
jString FastString
"oops: entered multiple times"])
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$done") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"done" (Int -> CILayout
CILayoutUnknown Int
0) CIType
CIStackFrame forall a. Monoid a => a
mempty)
               (FastString -> [JExpr] -> JStat
appS FastString
"h$finishThread" [FastString -> JExpr
var FastString
"h$currentThread"] forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS (FastString -> JExpr
var FastString
"h$reschedule"))
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$doneMain_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"doneMain" (Int -> CILayout
CILayoutUnknown Int
0) CIType
CIStackFrame forall a. Monoid a => a
mempty)
               (JExpr -> JStat
returnS (FastString -> JExpr
var FastString
"h$doneMain"))
          , Ident -> FastString -> CILayout -> Int -> JStat
conClosure (FastString -> Ident
TxtI FastString
"h$false_e") FastString
"GHC.Types.False" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) Int
1
          , Ident -> FastString -> CILayout -> Int -> JStat
conClosure (FastString -> Ident
TxtI FastString
"h$true_e" ) FastString
"GHC.Types.True"  (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) Int
2
          -- generic data constructor with 1 non-heapobj field
          , Ident -> FastString -> CILayout -> Int -> JStat
conClosure (FastString -> Ident
TxtI FastString
"h$data1_e") FastString
"data1" (Int -> [VarType] -> CILayout
CILayoutFixed Int
1 [VarType
ObjV]) Int
1
          -- generic data constructor with 2 non-heapobj fields
          , Ident -> FastString -> CILayout -> Int -> JStat
conClosure (FastString -> Ident
TxtI FastString
"h$data2_e") FastString
"data2" (Int -> [VarType] -> CILayout
CILayoutFixed Int
2 [VarType
ObjV,VarType
ObjV]) Int
1
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$noop_e") (Int -> [VarType] -> CIRegs
CIRegs Int
1 [VarType
PtrV]) FastString
"no-op IO ()" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) (Int -> Int -> CIType
CIFun Int
1 Int
0) forall a. Monoid a => a
mempty)
               (JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp))
            forall a. Semigroup a => a -> a -> a
<> (FastString -> Ident
TxtI FastString
"h$noop" Ident -> JExpr -> JStat
||= JExpr -> [JExpr] -> JExpr
ApplExpr (FastString -> JExpr
var FastString
"h$c0") (FastString -> JExpr
var FastString
"h$noop_e" forall a. a -> [a] -> [a]
: [JExpr
jSystemCCS | StgToJSConfig -> Bool
csProf StgToJSConfig
s]))
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$catch_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"exception handler" (Int -> [VarType] -> CILayout
CILayoutFixed Int
2 [VarType
PtrV,VarType
IntV]) CIType
CIStackFrame forall a. Monoid a => a
mempty)
               (Int -> JStat
adjSpN' Int
3 forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp))
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$dataToTag_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"data to tag" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame forall a. Monoid a => a
mempty)
                forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [ JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr -> JExpr -> JExpr -> JExpr
if_ (JExpr
r1 JExpr -> JExpr -> JExpr
.===. JExpr
true_) JExpr
1 (JExpr -> JExpr -> JExpr -> JExpr
if_ (JExpr -> JExpr
typeof JExpr
r1 JExpr -> JExpr -> JExpr
.===. JExpr
jTyObject) (JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"f" JExpr -> FastString -> JExpr
.^ FastString
"a" forall a. Num a => a -> a -> a
- JExpr
1) JExpr
0)
                          , Int -> JStat
adjSpN' Int
1
                          , JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp)
                          ]
          -- function application to one argument
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$ap1_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"apply1" (Int -> [VarType] -> CILayout
CILayoutFixed Int
2 [VarType
PtrV, VarType
PtrV]) CIType
CIThunk forall a. Monoid a => a
mempty)
               (forall a. ToSat a => a -> JStat
jVar forall a b. (a -> b) -> a -> b
$ \JExpr
d1 JExpr
d2 ->
                   forall a. Monoid a => [a] -> a
mconcat [ JExpr
d1 JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField1 JExpr
r1
                           , JExpr
d2 JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField2 JExpr
r1
                           , FastString -> [JExpr] -> JStat
appS FastString
"h$bh" []
                           , StgToJSConfig -> JStat -> JStat
profStat StgToJSConfig
s JStat
enterCostCentreThunk
                           , JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr
d1
                           , JExpr
r2 JExpr -> JExpr -> JStat
|= JExpr
d2
                           , JExpr -> JStat
returnS (FastString -> [JExpr] -> JExpr
app FastString
"h$ap_1_1_fast" [])
                           ])
          -- function application to two arguments
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$ap2_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"apply2" (Int -> [VarType] -> CILayout
CILayoutFixed Int
3 [VarType
PtrV, VarType
PtrV, VarType
PtrV]) CIType
CIThunk forall a. Monoid a => a
mempty)
               (forall a. ToSat a => a -> JStat
jVar forall a b. (a -> b) -> a -> b
$ \JExpr
d1 JExpr
d2 JExpr
d3 ->
                   forall a. Monoid a => [a] -> a
mconcat [ JExpr
d1 JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField1 JExpr
r1
                           , JExpr
d2 JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField2 JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"d1"
                           , JExpr
d3 JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField2 JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"d2"
                           , FastString -> [JExpr] -> JStat
appS FastString
"h$bh" []
                           , StgToJSConfig -> JStat -> JStat
profStat StgToJSConfig
s JStat
enterCostCentreThunk
                           , JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr
d1
                           , JExpr
r2 JExpr -> JExpr -> JStat
|= JExpr
d2
                           , JExpr
r3 JExpr -> JExpr -> JStat
|= JExpr
d3
                           , JExpr -> JStat
returnS (FastString -> [JExpr] -> JExpr
app FastString
"h$ap_2_2_fast" [])
                           ])
          -- function application to three arguments
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$ap3_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"apply3" (Int -> [VarType] -> CILayout
CILayoutFixed Int
4 [VarType
PtrV, VarType
PtrV, VarType
PtrV, VarType
PtrV]) CIType
CIThunk forall a. Monoid a => a
mempty)
               (forall a. ToSat a => a -> JStat
jVar forall a b. (a -> b) -> a -> b
$ \JExpr
d1 JExpr
d2 JExpr
d3 JExpr
d4 ->
                   forall a. Monoid a => [a] -> a
mconcat [ JExpr
d1 JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField1 JExpr
r1
                           , JExpr
d2 JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField2 JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"d1"
                           , JExpr
d3 JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField2 JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"d2"
                           , JExpr
d4 JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField2 JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"d3"
                           , FastString -> [JExpr] -> JStat
appS FastString
"h$bh" []
                           , JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr
d1
                           , JExpr
r2 JExpr -> JExpr -> JStat
|= JExpr
d2
                           , JExpr
r3 JExpr -> JExpr -> JStat
|= JExpr
d3
                           , JExpr
r4 JExpr -> JExpr -> JStat
|= JExpr
d4
                           , JExpr -> JStat
returnS (FastString -> [JExpr] -> JExpr
app FastString
"h$ap_3_3_fast" [])
                           ])
          -- select first field
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$select1_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"select1" (Int -> [VarType] -> CILayout
CILayoutFixed Int
1 [VarType
PtrV]) CIType
CIThunk forall a. Monoid a => a
mempty)
               (forall a. ToSat a => a -> JStat
jVar forall a b. (a -> b) -> a -> b
$ \JExpr
t ->
                   forall a. Monoid a => [a] -> a
mconcat [ JExpr
t JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField1 JExpr
r1
                           , Int -> JStat
adjSp' Int
3
                           , JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp forall a. Num a => a -> a -> a
- JExpr
2) JExpr -> JExpr -> JStat
|= JExpr
r1
                           , JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp forall a. Num a => a -> a -> a
- JExpr
1) JExpr -> JExpr -> JStat
|= FastString -> JExpr
var FastString
"h$upd_frame"
                           , JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp JExpr -> JExpr -> JStat
|= FastString -> JExpr
var FastString
"h$select1_ret"
                           , JExpr -> JExpr
closureEntry  JExpr
r1 JExpr -> JExpr -> JStat
|= FastString -> JExpr
var FastString
"h$blackhole"
                           , JExpr -> JExpr
closureField1 JExpr
r1 JExpr -> JExpr -> JStat
|= FastString -> JExpr
var FastString
"h$currentThread"
                           , JExpr -> JExpr
closureField2 JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr
null_
                           , JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr
t
                           , JExpr -> JStat
returnS (FastString -> [JExpr] -> JExpr
app FastString
"h$ap_0_0_fast" [])
                           ])
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$select1_ret") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"select1ret" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame forall a. Monoid a => a
mempty)
               ((JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField1 JExpr
r1)
                forall a. Semigroup a => a -> a -> a
<> Int -> JStat
adjSpN' Int
1
                forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS (FastString -> [JExpr] -> JExpr
app FastString
"h$ap_0_0_fast" [])
               )
          -- select second field of a two-field constructor
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$select2_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"select2" (Int -> [VarType] -> CILayout
CILayoutFixed Int
1 [VarType
PtrV]) CIType
CIThunk forall a. Monoid a => a
mempty)
               (forall a. ToSat a => a -> JStat
jVar forall a b. (a -> b) -> a -> b
$ \JExpr
t ->
                   forall a. Monoid a => [a] -> a
mconcat [JExpr
t JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField1 JExpr
r1
                           , Int -> JStat
adjSp' Int
3
                           , JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp forall a. Num a => a -> a -> a
- JExpr
2) JExpr -> JExpr -> JStat
|= JExpr
r1
                           , JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp forall a. Num a => a -> a -> a
- JExpr
1) JExpr -> JExpr -> JStat
|= FastString -> JExpr
var FastString
"h$upd_frame"
                           , JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp JExpr -> JExpr -> JStat
|= FastString -> JExpr
var FastString
"h$select2_ret"
                           , JExpr -> JExpr
closureEntry  JExpr
r1 JExpr -> JExpr -> JStat
|= FastString -> JExpr
var FastString
"h$blackhole"
                           , JExpr -> JExpr
closureField1 JExpr
r1 JExpr -> JExpr -> JStat
|= FastString -> JExpr
var FastString
"h$currentThread"
                           , JExpr -> JExpr
closureField2 JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr
null_
                           , JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr
t
                           , JExpr -> JStat
returnS (FastString -> [JExpr] -> JExpr
app FastString
"h$ap_0_0_fast" [])
                           ]
                  )
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$select2_ret") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"select2ret" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame forall a. Monoid a => a
mempty)
                        forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [ JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField2 JExpr
r1
                                  , Int -> JStat
adjSpN' Int
1
                                  , JExpr -> JStat
returnS (FastString -> [JExpr] -> JExpr
app FastString
"h$ap_0_0_fast" [])
                                  ]
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$keepAlive_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"keepAlive" (Int -> [VarType] -> CILayout
CILayoutFixed Int
1 [VarType
PtrV]) CIType
CIStackFrame forall a. Monoid a => a
mempty)
                    (forall a. Monoid a => [a] -> a
mconcat [ Int -> JStat
adjSpN' Int
2
                             , JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp)
                             ]
                    )
          -- a thunk that just raises a synchronous exception
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$raise_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"h$raise_e" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIThunk forall a. Monoid a => a
mempty)
               (JExpr -> JStat
returnS (FastString -> [JExpr] -> JExpr
app FastString
"h$throw" [JExpr -> JExpr
closureField1 JExpr
r1, JExpr
false_]))
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$raiseAsync_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"h$raiseAsync_e" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIThunk forall a. Monoid a => a
mempty)
               (JExpr -> JStat
returnS  (FastString -> [JExpr] -> JExpr
app FastString
"h$throw" [JExpr -> JExpr
closureField1 JExpr
r1, JExpr
true_]))
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$raiseAsync_frame") (Int -> [VarType] -> CIRegs
CIRegs Int
0 []) FastString
"h$raiseAsync_frame" (Int -> [VarType] -> CILayout
CILayoutFixed Int
1 []) CIType
CIStackFrame forall a. Monoid a => a
mempty)
               (forall a. ToSat a => a -> JStat
jVar forall a b. (a -> b) -> a -> b
$ \JExpr
ex ->
                   forall a. Monoid a => [a] -> a
mconcat [ JExpr
ex JExpr -> JExpr -> JStat
|= JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp forall a. Num a => a -> a -> a
- JExpr
1)
                           , Int -> JStat
adjSpN' Int
2
                           , JExpr -> JStat
returnS (FastString -> [JExpr] -> JExpr
app FastString
"h$throw" [JExpr
ex, JExpr
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 -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$reduce") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"h$reduce" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame forall a. Monoid a => a
mempty)
               (JExpr -> JStat -> JStat -> JStat
ifS (JExpr -> JExpr
isThunk JExpr
r1)
                    (JExpr -> JStat
returnS (JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"f"))
                    (Int -> JStat
adjSpN' Int
1 forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp))
               )
          , StgToJSConfig -> JStat
rtsApply StgToJSConfig
s
          , JStat
closureTypes
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$runio_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"runio" (Int -> [VarType] -> CILayout
CILayoutFixed Int
1 [VarType
PtrV]) CIType
CIThunk forall a. Monoid a => a
mempty)
                        forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [ JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField1 JExpr
r1
                                  , JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr -> JExpr
PreInc JExpr
sp JExpr -> JExpr -> JStat
|= FastString -> JExpr
var FastString
"h$ap_1_0"
                                  , JExpr -> JStat
returnS (FastString -> JExpr
var FastString
"h$ap_1_0")
                                  ]
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$flushStdout_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 []) FastString
"flushStdout" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIThunk forall a. Monoid a => a
mempty)
                        forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [ JExpr
r1 JExpr -> JExpr -> JStat
|= FastString -> JExpr
var FastString
"h$baseZCGHCziIOziHandlezihFlush"
                                  , JExpr
r2 JExpr -> JExpr -> JStat
|= FastString -> JExpr
var FastString
"h$baseZCGHCziIOziHandleziFDzistdout"
                                  , JExpr -> JStat
returnS (FastString -> [JExpr] -> JExpr
app FastString
"h$ap_1_1_fast" [])
                                  ]
          , FastString -> Ident
TxtI FastString
"h$flushStdout" Ident -> JExpr -> JStat
||= FastString -> [JExpr] -> JExpr
app FastString
"h$static_thunk" [FastString -> JExpr
var FastString
"h$flushStdout_e"]
          -- the scheduler pushes this frame when suspending a thread that
          -- has not called h$reschedule explicitly
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$restoreThread") (Int -> [VarType] -> CIRegs
CIRegs Int
0 []) FastString
"restoreThread" CILayout
CILayoutVariable CIType
CIStackFrame forall a. Monoid a => a
mempty)
                (forall a. ToSat a => a -> JStat
jVar forall a b. (a -> b) -> a -> b
$ \JExpr
f JExpr
frameSize JExpr
nregs ->
                    forall a. Monoid a => [a] -> a
mconcat [JExpr
f JExpr -> JExpr -> JStat
|= JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp forall a. Num a => a -> a -> a
- JExpr
2)
                            , JExpr
frameSize JExpr -> JExpr -> JStat
|= JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp forall a. Num a => a -> a -> a
- JExpr
1)
                            , JExpr
nregs JExpr -> JExpr -> JStat
|= JExpr
frameSize forall a. Num a => a -> a -> a
- JExpr
3
                            , JExpr -> (JExpr -> JExpr) -> (JExpr -> JStat) -> JStat
loop JExpr
1 (JExpr -> JExpr -> JExpr
.<=. JExpr
nregs)
                                     (\JExpr
i -> FastString -> [JExpr] -> JStat
appS FastString
"h$setReg" [JExpr
i, JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp forall a. Num a => a -> a -> a
- JExpr
2 forall a. Num a => a -> a -> a
- JExpr
i)] forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
postIncrS JExpr
i)
                            , JExpr
sp JExpr -> JExpr -> JStat
|= JExpr
sp forall a. Num a => a -> a -> a
- JExpr
frameSize
                            , JExpr -> JStat
returnS JExpr
f
                            ])
          -- return a closure in the stack frame to the next thing on the stack
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$return") (Int -> [VarType] -> CIRegs
CIRegs Int
0 []) FastString
"return" (Int -> [VarType] -> CILayout
CILayoutFixed Int
1 [VarType
PtrV]) CIType
CIStackFrame forall a. Monoid a => a
mempty)
                ((JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp forall a. Num a => a -> a -> a
- JExpr
1))
                 forall a. Semigroup a => a -> a -> a
<> Int -> JStat
adjSpN' Int
2
                 forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp))
          --  return a function in the stack frame for the next call
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$returnf") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"returnf" (Int -> [VarType] -> CILayout
CILayoutFixed Int
1 [VarType
ObjV]) CIType
CIStackFrame forall a. Monoid a => a
mempty)
                (forall a. ToSat a => a -> JStat
jVar forall a b. (a -> b) -> a -> b
$ \JExpr
r ->
                    forall a. Monoid a => [a] -> a
mconcat [ JExpr
r JExpr -> JExpr -> JStat
|= JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp forall a. Num a => a -> a -> a
- JExpr
1)
                            , Int -> JStat
adjSpN' Int
2
                            , JExpr -> JStat
returnS JExpr
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 -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$reschedule") (Int -> [VarType] -> CIRegs
CIRegs Int
0 []) FastString
"reschedule" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIThunk forall a. Monoid a => a
mempty)
                (JExpr -> JStat
returnS forall a b. (a -> b) -> a -> b
$ FastString -> JExpr
var FastString
"h$reschedule")
          -- debug thing, insert on stack to dump current result, should be boxed
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$dumpRes") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"dumpRes" (Int -> [VarType] -> CILayout
CILayoutFixed Int
1 [VarType
ObjV]) CIType
CIThunk forall a. Monoid a => a
mempty)
                (forall a. ToSat a => a -> JStat
jVar forall a b. (a -> b) -> a -> b
$ \JExpr
re ->
                    forall a. Monoid a => [a] -> a
mconcat [ FastString -> [JExpr] -> JStat
appS FastString
"h$log" [FastString -> JExpr
jString FastString
"h$dumpRes result: " forall a. Num a => a -> a -> a
+ JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
spforall a. Num a => a -> a -> a
-JExpr
1)]
                            , FastString -> [JExpr] -> JStat
appS FastString
"h$log" [JExpr
r1]
                            , FastString -> [JExpr] -> JStat
appS FastString
"h$log" [FastString -> [JExpr] -> JExpr
app FastString
"h$collectProps" [JExpr
r1]]
                            , JExpr -> JStat -> JStat
jwhenS ((JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"f") JExpr -> JExpr -> JExpr
.&&. (JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"f" JExpr -> FastString -> JExpr
.^ FastString
"n"))
                                        (FastString -> [JExpr] -> JStat
appS FastString
"h$log" [FastString -> JExpr
jString FastString
"name: " forall a. Num a => a -> a -> a
+ JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"f" JExpr -> FastString -> JExpr
.^ FastString
"n"])
                            , JExpr -> JStat -> JStat
jwhenS (JExpr -> [JExpr] -> JExpr
ApplExpr (JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"hasOwnProperty") [FastString -> JExpr
jString FastString
closureField1_])
                                        (FastString -> [JExpr] -> JStat
appS FastString
"h$log" [FastString -> JExpr
jString FastString
"d1: " forall a. Num a => a -> a -> a
+ JExpr -> JExpr
closureField1 JExpr
r1])
                            , JExpr -> JStat -> JStat
jwhenS (JExpr -> [JExpr] -> JExpr
ApplExpr (JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"hasOwnProperty") [FastString -> JExpr
jString FastString
closureField2_])
                                        (FastString -> [JExpr] -> JStat
appS FastString
"h$log" [FastString -> JExpr
jString FastString
"d2: " forall a. Num a => a -> a -> a
+ JExpr -> JExpr
closureField2 JExpr
r1])
                            , JExpr -> JStat -> JStat
jwhenS (JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"f") forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
                                [ JExpr
re JExpr -> JExpr -> JStat
|= JExpr -> JExpr
New (FastString -> [JExpr] -> JExpr
app FastString
"RegExp" [FastString -> JExpr
jString FastString
"([^\\n]+)\\n(.|\\n)*"])
                                , FastString -> [JExpr] -> JStat
appS FastString
"h$log" [FastString -> JExpr
jString FastString
"function"
                                                forall a. Num a => a -> a -> a
+ JExpr -> [JExpr] -> JExpr
ApplExpr (JExpr -> [JExpr] -> JExpr
ApplExpr ((FastString -> JExpr
jString FastString
"" forall a. Num a => a -> a -> a
+ JExpr
r1 JExpr -> FastString -> JExpr
.^ FastString
"f") JExpr -> FastString -> JExpr
.^ FastString
"substring") [JExpr
0, JExpr
50] JExpr -> FastString -> JExpr
.^ FastString
"replace") [JExpr
r1, FastString -> JExpr
jString FastString
"$1"]]
                                ]
                            , Int -> JStat
adjSpN' Int
2
                            , JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr
null_
                            , JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp)
                            ])
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$resume_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"resume" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIThunk forall a. Monoid a => a
mempty)
                  (forall a. ToSat a => a -> JStat
jVar forall a b. (a -> b) -> a -> b
$ \JExpr
ss ->
                      forall a. Monoid a => [a] -> a
mconcat [JExpr
ss JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField1 JExpr
r1
                              , StgToJSConfig -> JStat
updateThunk' StgToJSConfig
s
                              , JExpr -> (JExpr -> JExpr) -> (JExpr -> JStat) -> JStat
loop JExpr
0 (JExpr -> JExpr -> JExpr
.<. JExpr
ss JExpr -> FastString -> JExpr
.^ FastString
"length") (\JExpr
i -> (JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
spforall a. Num a => a -> a -> a
+JExpr
1forall a. Num a => a -> a -> a
+JExpr
i) JExpr -> JExpr -> JStat
|= JExpr
ss JExpr -> JExpr -> JExpr
.! JExpr
i)
                                                                   forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
postIncrS JExpr
i)
                              , JExpr
sp JExpr -> JExpr -> JStat
|= JExpr
sp forall a. Num a => a -> a -> a
+ JExpr
ss JExpr -> FastString -> JExpr
.^ FastString
"length"
                              , JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr
null_
                              , JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp)
                              ])
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$unmaskFrame") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"unmask" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame forall a. Monoid a => a
mempty)
               ((FastString -> JExpr
var FastString
"h$currentThread" JExpr -> FastString -> JExpr
.^ FastString
"mask" JExpr -> JExpr -> JStat
|= JExpr
0)
                forall a. Semigroup a => a -> a -> a
<> Int -> JStat
adjSpN' Int
1
                -- back to scheduler to give us async exception if pending
                forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat -> JStat -> JStat
ifS (FastString -> JExpr
var FastString
"h$currentThread" JExpr -> FastString -> JExpr
.^ FastString
"excep" JExpr -> FastString -> JExpr
.^ FastString
"length" JExpr -> JExpr -> JExpr
.>. JExpr
0)
                    (StgToJSConfig -> [JExpr] -> JStat
push' StgToJSConfig
s [JExpr
r1, FastString -> JExpr
var FastString
"h$return"] forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS (FastString -> JExpr
var FastString
"h$reschedule"))
                    (JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp)))
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$maskFrame") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"mask" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame forall a. Monoid a => a
mempty)
                ((FastString -> JExpr
var FastString
"h$currentThread" JExpr -> FastString -> JExpr
.^ FastString
"mask" JExpr -> JExpr -> JStat
|= JExpr
2)
                 forall a. Semigroup a => a -> a -> a
<> Int -> JStat
adjSpN' Int
1
                 forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp))
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$maskUnintFrame") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"maskUnint" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame forall a. Monoid a => a
mempty)
                ((FastString -> JExpr
var FastString
"h$currentThread" JExpr -> FastString -> JExpr
.^ FastString
"mask" JExpr -> JExpr -> JStat
|= JExpr
1)
                 forall a. Semigroup a => a -> a -> a
<> Int -> JStat
adjSpN' Int
1
                 forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp))
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$unboxFFIResult") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"unboxFFI" (Int -> [VarType] -> CILayout
CILayoutFixed Int
0 []) CIType
CIStackFrame forall a. Monoid a => a
mempty)
               (forall a. ToSat a => a -> JStat
jVar forall a b. (a -> b) -> a -> b
$ \JExpr
d ->
                   forall a. Monoid a => [a] -> a
mconcat [JExpr
d JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField1 JExpr
r1
                           , JExpr -> (JExpr -> JExpr) -> (JExpr -> JStat) -> JStat
loop JExpr
0 (JExpr -> JExpr -> JExpr
.<. JExpr
d JExpr -> FastString -> JExpr
.^ FastString
"length") (\JExpr
i -> FastString -> [JExpr] -> JStat
appS FastString
"h$setReg" [JExpr
i forall a. Num a => a -> a -> a
+ JExpr
1, JExpr
d JExpr -> JExpr -> JExpr
.! JExpr
i] forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
postIncrS JExpr
i)
                           , Int -> JStat
adjSpN' Int
1
                           , JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp)
                           ])
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$unbox_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"unboxed value" (Int -> [VarType] -> CILayout
CILayoutFixed Int
1 [VarType
DoubleV]) CIType
CIThunk forall a. Monoid a => a
mempty)
               ((JExpr
r1 JExpr -> JExpr -> JStat
|= JExpr -> JExpr
closureField1 JExpr
r1) forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp))
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$retryInterrupted") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
ObjV]) FastString
"retry interrupted operation" (Int -> [VarType] -> CILayout
CILayoutFixed Int
1 [VarType
ObjV]) CIType
CIStackFrame forall a. Monoid a => a
mempty)
               (forall a. ToSat a => a -> JStat
jVar forall a b. (a -> b) -> a -> b
$ \JExpr
a ->
                   forall a. Monoid a => [a] -> a
mconcat [ JExpr
a JExpr -> JExpr -> JStat
|= JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp forall a. Num a => a -> a -> a
- JExpr
1)
                           , Int -> JStat
adjSpN' Int
2
                           , JExpr -> JStat
returnS (JExpr -> [JExpr] -> JExpr
ApplExpr (JExpr
a JExpr -> JExpr -> JExpr
.! JExpr
0 JExpr -> FastString -> JExpr
.^ FastString
"apply") [FastString -> JExpr
var FastString
"this", JExpr -> [JExpr] -> JExpr
ApplExpr (JExpr
a JExpr -> FastString -> JExpr
.^ FastString
"slice") [JExpr
1]])
                           ])
          , ClosureInfo -> JStat -> JStat
closure (Ident
-> CIRegs
-> FastString
-> CILayout
-> CIType
-> CIStatic
-> ClosureInfo
ClosureInfo (FastString -> Ident
TxtI FastString
"h$atomically_e") (Int -> [VarType] -> CIRegs
CIRegs Int
0 [VarType
PtrV]) FastString
"atomic operation" (Int -> [VarType] -> CILayout
CILayoutFixed Int
1 [VarType
PtrV]) CIType
CIStackFrame forall a. Monoid a => a
mempty)
               (JExpr -> JStat -> JStat -> JStat
ifS (FastString -> [JExpr] -> JExpr
app FastString
"h$stmValidateTransaction" [])
                    (FastString -> [JExpr] -> JStat
appS FastString
"h$stmCommitTransaction" []
                     forall a. Semigroup a => a -> a -> a
<> Int -> JStat
adjSpN' Int
2
                     forall a. Semigroup a => a -> a -> a
<> JExpr -> JStat
returnS (JExpr
stack JExpr -> JExpr -> JExpr
.! JExpr
sp))
                    (JExpr -> JStat
returnS (FastString -> [JExpr] -> JExpr
app FastString
"h$stmStartTransaction" [JExpr
stack JExpr -> JExpr -> JExpr
.! (JExpr
sp forall a. Num a => a -> a -> a
- JExpr
1)])))

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