Add JS.Rts

JS.Rts: compiles reword: progress on RtsTypes StgToJS.Config: add SDoc Context JSRts: move ppr, workaround def type JSRts.Types: compiles JS.Rts: closer to compiling JS.Rts: move jsIdIdent' to StgToJS.Monad JS.Rts: remove unused predicates JS: cleanup, comment sections, math funcs to Make JS.Rts.Types: compiles StgToJS.Expr: fix compilation errors StgToJS.DataCon: move initClosure JS.Rts: remove Alloc module JS.Rts: initalize Rts module, remove redundant fs JS: init Rts.Alloc move initClosure JS.Apply: unwinding combinators in progress JS: add helpers and fixmes JS.Rts.Apply: no more e's, add closure, reg helper StgToJS: add ToStat instance ClosureInfo JS.Rts.Apply: closer to compiling JS.Rts.Apply: more removal of # JS.Rts.Apply: (#) removed JS.Rts.Apply: compiles JS.Rts.Rts: just pretty printing left JS.Rts: Add Notes JS.Rts: add file headers and notes JS.Rts.Rts: fixing stringy issues JS.Rts.Rts: compiles JS.Rts.Rts: fix non-exhaustive patterns warnings
author: doyougnu <jeffrey.young@iohk.io> 2022-03-04 10:32:56 -0500
committer: doyougnu <jeffrey.young@iohk.io> 2022-06-13 13:42:36 -0400
commit: e5cb7c869cfde63a1b3fc49b458e0a48e2a20b6c (patch)
tree: 40becf2c33bbf75b04897143630f53c6ce88465e
parent: c785dd78159dd3f1d25a8f86079cb6e06f48a707 (diff)
download: haskell-e5cb7c869cfde63a1b3fc49b458e0a48e2a20b6c.tar.gz
17 files changed, 1936 insertions, 76 deletions
diff --git a/compiler/GHC/Driver/Config/StgToJS.hs b/compiler/GHC/Driver/Config/StgToJS.hs
index 69bb27953c..b94d3fcaa7 100644
--- a/compiler/GHC/Driver/Config/StgToJS.hs
+++ b/compiler/GHC/Driver/Config/StgToJS.hs
@@ -3,14 +3,18 @@ module GHC.Driver.Config.StgToJS
   )
 where
 
-import GHC.Prelude
+import GHC.StgToJS.Types
+
 import GHC.Driver.Session
 import GHC.Platform.Ways
-import GHC.StgToJS.Types
+import GHC.Utils.Outputable
+
+import GHC.Prelude
 
 -- | Initialize StgToJS settings from DynFlags
 initStgToJSConfig :: DynFlags -> StgToJSConfig
 initStgToJSConfig dflags = StgToJSConfig
+  -- flags
   { csInlinePush      = False
   , csInlineBlackhole = False
   , csInlineLoadRegs  = False
@@ -22,4 +26,6 @@ initStgToJSConfig dflags = StgToJSConfig
   , csTraceForeign    = False
   , csProf            = ways dflags `hasWay` WayProf
   , csRuntimeAssert   = False
+  -- settings
+  , csContext         = initSDocContext dflags defaultDumpStyle
   }
diff --git a/compiler/GHC/JS/Make.hs b/compiler/GHC/JS/Make.hs
index 2987e1a1a9..07659c664f 100644
--- a/compiler/GHC/JS/Make.hs
+++ b/compiler/GHC/JS/Make.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
@@ -6,13 +5,15 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE BlockArguments #-}
-{-# LANGUAGE PatternSynonyms #-}
+
+{-# OPTIONS_GHC -fno-warn-orphans #-} -- only for Num, Fractional on JExpr
 
 -- | Helpers to create JS syntax values
 module GHC.JS.Make
   ( ToJExpr (..)
   , ToStat (..)
   , var
+  , jString
   -- * Literals
   , null_
   , undefined_
@@ -31,8 +32,9 @@ module GHC.JS.Make
   , (||=), (|=), (.==.), (.===.), (.!=.), (.!==.), (.!)
   , (.>.), (.>=.), (.<.), (.<=.)
   , (.<<.), (.>>.), (.>>>.)
-  , (.||.), (.&&.)
+  , (.|.), (.||.), (.&&.)
   , if_, if10, if01, ifS, ifBlockS
+  , jwhenS
   , app, appS, returnS
   , jLam, jVar, jFor, jForIn, jForEachIn, jTryCatchFinally
   , loop, loopBlockS
@@ -46,10 +48,15 @@ module GHC.JS.Make
   , returnStack, assignAllEqual, assignAll
   , declAssignAll
   , nullStat, (.^)
+  -- * Math functions
+  , math_log, math_sin, math_cos, math_tan, math_exp, math_acos, math_asin,
+    math_atan, math_abs, math_pow, math_sqrt, math_asinh, math_acosh, math_atanh
+  -- * Statement helpers
+  , decl
   )
 where
 
-import GHC.Prelude
+import GHC.Prelude hiding ((.|.))
 
 import GHC.JS.Syntax
 
@@ -70,7 +77,6 @@ import GHC.Utils.Misc
   ToJExpr Class
 --------------------------------------------------------------------}
 
-
 -- | Things that can be marshalled into javascript values.
 -- Instantiate for any necessary data structures.
 class ToJExpr a where
@@ -201,17 +207,25 @@ jTryCatchFinally s f s2 = UnsatBlock . IS $ do
 var :: ShortText -> JExpr
 var = ValExpr . JVar . TxtI
 
+-- | Convert a ShortText to a Javascript String
+jString :: ShortText -> JExpr
+jString = toJExpr
+
 jFor :: (ToJExpr a, ToStat b) => JStat -> a -> JStat -> b -> JStat
 jFor before p after b = BlockStat [before, WhileStat False (toJExpr p) b']
     where b' = case toStat b of
                  BlockStat xs -> BlockStat $ xs ++ [after]
                  x -> BlockStat [x,after]
 
+-- | construct a js declaration with the given identifier
+decl :: Ident -> JStat
+decl i = DeclStat i
+
 jhEmpty :: M.Map k JExpr
 jhEmpty = M.empty
 
 jhSingle :: (Ord k, ToJExpr a) => k -> a -> M.Map k JExpr
-jhSingle k v = jhAdd k v $ jhEmpty
+jhSingle k v = jhAdd k v jhEmpty
 
 jhAdd :: (Ord k, ToJExpr a) => k -> a -> M.Map k JExpr -> M.Map k JExpr
 jhAdd  k v m = M.insert k (toJExpr v) m
@@ -244,7 +258,8 @@ infixl 6 .==., .===., .!=., .!==.
 
 infixl 7 .>., .>=., .<., .<=.
 
-(.||.), (.&&.)  :: JExpr -> JExpr -> JExpr
+(.|.), (.||.), (.&&.)  :: JExpr -> JExpr -> JExpr
+(.|.)   = InfixExpr BOrOp
 (.||.)  = InfixExpr LOrOp
 (.&&.)  = InfixExpr LAndOp
 
@@ -268,6 +283,10 @@ if_ e1 e2 e3 = IfExpr e1 e2 e3
 ifS :: JExpr -> JStat -> JStat -> JStat
 ifS e s1 s2 = IfStat e s1 s2
 
+-- if(e) { s1 } else {  }
+jwhenS :: JExpr -> JStat -> JStat
+jwhenS cond block = ifS cond block mempty
+
 -- if(e) { s1 } else { s2 }
 ifBlockS :: JExpr -> [JStat] -> [JStat] -> JStat
 ifBlockS e s1 s2 = IfStat e (mconcat s1) (mconcat s2)
@@ -280,6 +299,7 @@ if10 e = IfExpr e one_ zero_
 if01 :: JExpr -> JExpr
 if01 e = IfExpr e zero_ one_
 
+-- | an expression application; app f xs <==> f(xs)
 app :: ShortText -> [JExpr] -> JExpr
 app f xs = ApplExpr (var f) xs
 
@@ -459,4 +479,43 @@ takeOneIdent = do
       return x
     _ -> error "takeOneIdent: empty list"
 
-
+--------------------------------------------------------------------------------
+--                            Math functions
+--------------------------------------------------------------------------------
+math :: JExpr
+math = var "Math"
+
+math_ :: ShortText -> [JExpr] -> JExpr
+math_ op args = ApplExpr (math .^ op) args
+
+math_log, math_sin, math_cos, math_tan, math_exp, math_acos, math_asin, math_atan,
+  math_abs, math_pow, math_sqrt, math_asinh, math_acosh, math_atanh, math_sign
+  :: [JExpr] -> JExpr
+math_log   = math_ "log"
+math_sin   = math_ "sin"
+math_cos   = math_ "cos"
+math_tan   = math_ "tan"
+math_exp   = math_ "exp"
+math_acos  = math_ "acos"
+math_asin  = math_ "asin"
+math_atan  = math_ "atan"
+math_abs   = math_ "abs"
+math_pow   = math_ "pow"
+math_sign  = math_ "sign"
+math_sqrt  = math_ "sqrt"
+math_asinh = math_ "asinh"
+math_acosh = math_ "acosh"
+math_atanh = math_ "atanh"
+
+instance Num JExpr where
+    x + y = InfixExpr AddOp x y
+    x - y = InfixExpr SubOp x y
+    x * y = InfixExpr MulOp x y
+    abs x    = math_abs [x]
+    negate x = UOpExpr NegOp x
+    signum x = math_sign [x]
+    fromInteger x = ValExpr (JInt x)
+
+instance Fractional JExpr where
+    x / y = InfixExpr DivOp x y
+    fromRational x = ValExpr (JDouble (realToFrac x))
diff --git a/compiler/GHC/JS/Rts/Apply.hs b/compiler/GHC/JS/Rts/Apply.hs
new file mode 100644
index 0000000000..02aa575efa
--- /dev/null
+++ b/compiler/GHC/JS/Rts/Apply.hs
@@ -0,0 +1,752 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.JS.Rts.Apply
+-- 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>
+-- Stability   :  experimental
+--
+--  Generate various apply functions for the RTS, for speeding up
+--  function application in the most common cases. The code is generated
+--  because it contains lots of repeating patterns, and to make it more
+--  flexible when changing the RTS (for example how arguments are passed)
+--
+--  The code in here can be a bit hard to read due to all the generated
+--  low-level access things. Reading rts.js for a compiled program can be
+--  easier (the file is always the same unless you change low-level RTS
+--  options)
+--
+--  FIXME: add selector thunks and let the gc follow them
+-----------------------------------------------------------------------------
+
+module GHC.JS.Rts.Apply where
+
+import GHC.JS.Syntax
+import GHC.JS.Make
+import GHC.JS.Rts.Types
+
+import GHC.StgToJS.DataCon
+import GHC.StgToJS.Heap
+import GHC.StgToJS.Monad
+import GHC.StgToJS.Profiling
+import GHC.StgToJS.Regs
+import GHC.StgToJS.Types
+
+import GHC.Types.CostCentre
+import GHC.Data.ShortText
+
+import qualified Data.Bits as Bits
+import Data.Semigroup ((<>))
+import GHC.Prelude hiding ((.|.))
+
+rtsApply :: StgToJSConfig -> JStat
+rtsApply cfg = mconcat $
+  map (uncurry (stackApply cfg)) applySpec
+  ++ map (uncurry (fastApply cfg)) applySpec
+  ++ map (pap cfg) specPap
+  ++ [ mkApplyArr
+     , genericStackApply cfg
+     , genericFastApply  cfg
+     , zeroApply cfg
+     , updates   cfg
+     , papGen    cfg
+     , moveRegs2
+     , selectors cfg
+     ]
+
+-- specialized apply for these
+-- make sure that once you are in spec, you stay there
+applySpec :: [(Int,Int)] -- regs,arity
+applySpec = [ (regs,arity)  | arity <- [1..4], regs <- [max 0 (arity-1)..(arity*2)]]
+
+specApply :: Bool -> Int -> Int -> Maybe JExpr
+specApply fast n r
+  | (r,n) == (0,0)         = Just (toJExpr . TxtI . pack $ "h$ap_0_0" ++ fastSuff)
+  | (r,n) == (0,1)         = Just (toJExpr . TxtI . pack $ "h$ap_1_0" ++ fastSuff)
+  | (r,n) `elem` applySpec =
+        Just (toJExpr . TxtI . pack $ "h$ap_" ++ show n ++ "_" ++ show r ++ fastSuff)
+  | otherwise = Nothing
+   where
+      fastSuff | fast      = "_fast"
+               | otherwise = ""
+{-
+  Build arrays to quickly lookup apply functions, getting the fast variant when possible
+   - h$apply[r << 8 | n] = function application for r regs, n args
+   - h$paps[r]           = partial application for r registers (number of args is in the object)
+ -}
+  -- FIXME (Jeff, 2022/03): Perf: This code would benefit a great deal by using
+  -- a datastucture that supports fast merging.
+mkApplyArr :: JStat
+mkApplyArr = mconcat
+  [ TxtI "h$apply" ||= toJExpr (JList mempty)
+  , TxtI "h$paps"  ||= toJExpr (JList mempty)
+  , (var "h$initStatic" .^ "push") `ApplStat`
+    [ValExpr (JFunc []
+              (jVar (\i -> mconcat
+                    [ i |= 0
+                    ,  WhileStat False (i .<. 65536)
+                      ((var "h$apply" .! i |= var "h$ap_gen")
+                       <> UOpStat PreIncOp i)
+                    , i |= 0
+                    , WhileStat False (i .<. 128)
+                      ((var "h$paps" .! i |= var "h$pap_gen")
+                       <> UOpStat PreIncOp i)
+                    , var "h$apply" .! 0 |= var "h$ap_0_0"
+                    , mconcat (map assignSpec applySpec)
+                    , mconcat (map assignPap specPap)
+                    ])))
+    ]]
+  where
+    assignSpec :: (Int, Int) -> JStat
+    assignSpec (r,n) =
+      var "h$apply" .! toJExpr (Bits.shiftL r 8 Bits..|. n) |=
+           toJExpr (TxtI . pack $ "h$ap_" ++ show n ++ "_" ++ show r)
+
+    assignPap :: Int -> JStat
+    assignPap p = var "h$paps" .! toJExpr p |=
+                      toJExpr (TxtI . pack $ "h$pap_" ++ show p)
+
+-- generic stack apply that can do everything, but less efficiently
+-- on stack: tag: (regs << 8 | arity)
+-- fixme: set closure info of stack frame
+genericStackApply :: StgToJSConfig -> JStat
+genericStackApply s =
+   closure (ClosureInfo "h$ap_gen" (CIRegs 0 [PtrV]) "h$ap_gen" CILayoutVariable CIStackFrame mempty)
+           (jVar $ \cf ->
+               mconcat [ traceRts s (jString "h$ap_gen")
+                       , cf |= r1 .^ "f"
+                       , SwitchStat (cf .^ "t")
+                         [ (toJExpr Thunk, profStat s pushRestoreCCS <> returnS cf)
+                         , (toJExpr Fun,   funCase cf (funArity' cf))
+                         , (toJExpr Pap,   funCase cf (papArity r1))
+                         , (toJExpr Blackhole, push' s [r1, var "h$return"]
+                             <> returnS (app "h$blockOnBlackhole" [r1]))
+                         ] (appS "throw" [jString "h$ap_gen: unexpected closure type " + (cf .^ "t")])
+                       ]
+            )
+  where
+    funCase c arity =
+      jVar $ \myArity ar myAr myRegs regs newTag newAp p dat ->
+      mconcat [ myArity |= stack .! (sp - 1)
+              , ar |= mask8 arity
+              , myAr |= mask8 myArity
+              , myRegs |= myArity .>>. 8
+              , traceRts s (jString "h$ap_gen: args: " + myAr
+                            + jString " regs: " + myRegs)
+              , ifS (myAr .===. ar)
+                -- then
+                (traceRts s (jString "h$ap_gen: exact")
+                  <> loop 0 (.<. myRegs)
+                                (\i -> appS "h$setReg" [i+2, stack .! (sp-2-i)]
+                                  <> postIncrS i)
+                  <> (sp |= sp - myRegs - 2)
+                  <> returnS c)
+                -- else
+                (ifS (myAr .>. ar)
+                        --then
+                        (mconcat [ regs |= arity .>>. 8
+                                 , traceRts s (jString "h$ap_gen: oversat: arity: " + ar
+                                               + jString " regs: " + regs)
+                                 , loop 0 (.<. regs)
+                                   (\i -> traceRts s (jString "h$ap_gen: loading register: " + i)
+                                     <> appS "h$setReg" [i+2, stack .! (sp-2-i)]
+                                     <> postIncrS i)
+                                 , newTag |= ((myRegs-regs).<<.8).|.myAr - ar
+                                 , newAp |= var "h$apply" .! newTag
+                                 , traceRts s (jString "h$ap_gen: next: " + (newAp .^ "n"))
+                                 , ifS (newAp .===. var "h$ap_gen")
+                                        ((sp |= sp - regs) <> (stack .! (sp - 1) |= newTag))
+                                        (sp |= sp - regs - 1)
+                                 , stack .! sp |= newAp
+                                 , profStat s pushRestoreCCS
+                                 , returnS c
+                                 ])
+                        -- else
+                        (traceRts s (jString "h$ap_gen: undersat")
+                         <> mconcat [ p   |= var "h$paps" .! myRegs
+                                    , dat |= toJExpr [r1, ((arity .>>. 8)-myRegs)*256+ar-myAr]
+                                    ,  loop 0 (.<. myRegs)
+                                       (\i -> (dat .^ "push") `ApplStat` [stack .! (sp - i - 2)]
+                                              <> postIncrS i)
+                                    , sp  |= sp - myRegs - 2
+                                    , r1  |= initClosure s p dat jCurrentCCS
+                                    , returnStack
+                                    ]))
+              ]
+
+{-
+  generic fast apply: can handle anything (slowly)
+  signature tag in argument
+-}
+genericFastApply :: StgToJSConfig -> JStat
+genericFastApply s =
+   TxtI "h$ap_gen_fast" ||= jLam (\tag -> jVar (\c ->
+      mconcat [traceRts s (jString "h$ap_gen_fast: " + tag)
+              , c |= r1 .^ "f"
+              , SwitchStat (c .^ "t")
+                [ (toJExpr Thunk, traceRts s (jString "h$ap_gen_fast: thunk")
+                   <> pushStackApply c tag
+                   <> returnS c)
+                , (toJExpr Fun, jVar (\farity ->
+                                       (farity |= funArity' c)
+                                       <> traceRts s (jString "h$ap_gen_fast: fun " + farity)
+                                       <> funCase c tag farity))
+                , (toJExpr Pap, jVar (\parity ->
+                                       (parity |= papArity r1)
+                                       <> traceRts s (jString "h$ap_gen_fast: pap " + parity)
+                                       <> funCase c tag parity)
+                          )
+                , (toJExpr Con, traceRts s (jString "h$ap_gen_fast: con")
+                    <> jwhenS (tag .!=. 0)
+                        (appS "throw" [jString "h$ap_gen_fast: invalid apply"])
+                                <> returnS c)
+                , (toJExpr Blackhole, traceRts s (jString "h$ap_gen_fast: blackhole")
+                    <> pushStackApply c tag
+                    <> push' s [r1, var "h$return"]
+                    <> returnS (app "h$blockOnBlackhole" [r1]))
+                ] $ appS "throw" [jString "h$ap_gen_fast: unexpected closure type: " + c .^ "t"]
+              ]))
+
+  where
+     -- thunk: push everything to stack frame, enter thunk first
+    pushStackApply :: JExpr -> JExpr -> JStat
+    pushStackApply _c tag =
+      jVar $ \ap ->
+      mconcat [ pushAllRegs tag
+              , ap |= var "h$apply" .! tag
+              , ifS (ap .===. var "h$ap_gen")
+                      ((sp |= sp + 2) <> (stack .! (sp-1) |= tag))
+                      (sp |= sp + 1)
+              , stack .! sp |= ap
+              , profStat s pushRestoreCCS
+              ]
+
+    funCase :: JExpr -> JExpr -> JExpr -> JStat
+    funCase c tag arity =
+      jVar $ \ar myAr myRegs regsStart newTag newAp dat p ->
+      mconcat [ ar     |= mask8 arity
+              , myAr   |= mask8 tag
+              , myRegs |= tag .>>. 8
+              , traceRts s (jString "h$ap_gen_fast: args: " + myAr
+                            + jString " regs: "             + myRegs)
+              , ifS (myAr .===. ar)
+              -- call the function directly
+                (traceRts s (jString "h$ap_gen_fast: exact") <> returnS c)
+                (ifS (myAr .>. ar)
+                -- push stack frame with remaining args, then call fun
+                 (mconcat [ traceRts s (jString "h$ap_gen_fast: oversat " + sp)
+                          , regsStart |= (arity .>>. 8) + 1
+                          , sp |= sp + myRegs - regsStart + 1
+                          , traceRts s (jString "h$ap_gen_fast: oversat " + sp)
+                          , pushArgs regsStart myRegs
+                          , newTag |= ((myRegs-( arity.>>.8)).<<.8).|.myAr-ar
+                          , newAp |= var "h$apply" .! newTag
+                          , ifS (newAp .===. var "h$ap_gen")
+                                ((sp |= sp + 2) <> (stack .! (sp - 1) |= newTag))
+                                (sp |= sp + 1)
+                          , stack .! sp |= newAp
+                          , profStat s pushRestoreCCS
+                          , returnS c
+                          ])
+                -- else
+                  (traceRts s (jString "h$ap_gen_fast: undersat: " + myRegs + jString " " + tag)
+                   <> jwhenS (tag .!=. 0)
+                        (mconcat [p |= var "h$paps" .! myRegs
+                                 , dat |= toJExpr [r1, ((arity .>>. 8)-myRegs)*256+ar-myAr]
+                                 , loop 0 (.<. myRegs)
+                                   (\i -> (dat .^ "push")
+                                     `ApplStat` [app "h$getReg" [i+2]] <> postIncrS i)
+                                 , r1 |= initClosure s p dat jCurrentCCS
+                                 ])
+                   <> returnStack))
+              ]
+
+
+    pushAllRegs :: JExpr -> JStat
+    pushAllRegs tag =
+      jVar $ \regs ->
+      mconcat [regs |= tag .>>. 8
+              , sp |= sp + regs
+              , SwitchStat regs (map pushReg [65,64..2]) mempty
+              ]
+      where
+        pushReg :: Int -> (JExpr, JStat)
+        pushReg r = (toJExpr (r-1),  stack .! (sp - toJExpr (r - 2)) |= toJExpr (intToJSReg r))
+
+    pushArgs :: JExpr -> JExpr -> JStat
+    pushArgs start end =
+      loop end (.>=.start) (\i -> traceRts s (jString "pushing register: " + i)
+                             <> (stack .! (sp + start - i) |= app "h$getReg" [i+1])
+                             <> postDecrS i
+                           )
+
+stackApply :: StgToJSConfig
+           -> Int         -- ^ number of registers in stack frame
+           -> Int         -- ^ number of arguments
+           -> JStat
+stackApply s r n =
+  closure (ClosureInfo funcName (CIRegs 0 [PtrV]) funcName layout CIStackFrame mempty)
+          body
+  where
+    layout    = CILayoutUnknown r
+
+    funcName = pack ("h$ap_" ++ show n ++ "_" ++ show r)
+
+    body = jVar $
+        \c ->
+          mconcat [ c |= r1 .^ "f"
+                  , traceRts s (toJExpr funcName
+                                + jString " "
+                                + (c .^ "n")
+                                + jString " sp: " + sp
+                                + jString " a: "  + (c .^ "a"))
+                  , SwitchStat (c .^ "t")
+                    [ (toJExpr Thunk, traceRts s (toJExpr $ funcName <> ": thunk") <> profStat s pushRestoreCCS <> returnS c)
+                    , (toJExpr Fun, traceRts s (toJExpr $ funcName <> ": fun") <> funCase c)
+                    , (toJExpr Pap, traceRts s (toJExpr $ funcName <> ": pap") <> papCase c)
+                    , (toJExpr Blackhole, push' s [r1, var "h$return"] <> returnS (app "h$blockOnBlackhole" [r1]))
+                    ] (appS "throw" [toJExpr ("panic: " <> funcName <> ", unexpected closure type: ") + (c .^ "t")])
+                  ]
+
+    funExact c = popSkip' 1 (reverse $ take r (map toJExpr $ enumFrom R2)) <> returnS c
+    stackArgs = map (\x -> stack .! (sp - toJExpr x)) [1..r]
+
+    papCase :: JExpr -> JStat
+    papCase c = jVar $ \expr arity0 arity ->
+      case expr of
+        ValExpr (JVar pap) -> mconcat [ arity0 |= papArity r1
+                                      , arity |= mask8 arity0
+                                      , traceRts s (toJExpr (funcName <> ": found pap, arity: ") + arity)
+                                      , ifS (toJExpr n .===. arity)
+                                      --then
+                                        (traceRts s (toJExpr (funcName <> ": exact")) <> funExact c)
+                                      -- else
+                                        (ifS (toJExpr n .>. arity)
+                                          (traceRts s (toJExpr (funcName <> ": oversat")) <> oversatCase c arity0 arity)
+                                          (traceRts s (toJExpr (funcName <> ": undersat"))
+                                           <> mkPap s pap r1 (toJExpr n) stackArgs -- FIXME do we want double pap?
+                                           <> (sp |= sp - toJExpr (r + 1))
+                                           <> (r1 |= toJExpr pap)
+                                           <> returnStack))
+                                      ]
+        _                   -> mempty -- FIXME: Jeff (2022,03), just quieting non-exhaustive
+                                      -- patterns. That the code wants to do this
+                                      -- means we should be encoding that funCase is
+                                      -- only callable on ValExpr (JVar pap)'s in
+                                      -- the type system, perhaps with a GADT or
+                                      -- phantom
+
+
+    funCase :: JExpr -> JStat
+    funCase c = jVar $ \expr ar0 ar ->
+      case expr of
+        ValExpr (JVar pap) -> mconcat [ ar0 |= funArity' c
+                                      , ar |= mask8 ar0
+                                      , ifS (toJExpr n .===. ar)
+                                        (traceRts s (toJExpr (funcName <> ": exact")) <> funExact c)
+                                        (ifS (toJExpr n .>. ar)
+                                         (traceRts s (toJExpr (funcName <> ": oversat"))
+                                          <> oversatCase c ar0 ar)
+                                         (traceRts s (toJExpr (funcName <> ": undersat"))
+                                          <> mkPap s pap (toJExpr R1) (toJExpr n) stackArgs
+                                          <> (sp |= sp - toJExpr (r+1))
+                                          <> (r1 |= toJExpr pap)
+                                          <> returnStack))
+                                      ]
+        _                  -> mempty  -- FIXME: Jeff (2022,03), just quieting non-exhaustive
+                                      -- patterns. That the code wants to do this
+                                      -- means we should be encoding that funCase is
+                                      -- only callable on ValExpr (JVar pap)'s in
+                                      -- the type system, perhaps with a GADT or
+                                      -- phantom
+
+
+    -- oversat: call the function but keep enough on the stack for the next
+    oversatCase :: JExpr -- function
+                -> JExpr -- the arity tag
+                -> JExpr -- real arity (arity & 0xff)
+                -> JStat
+    oversatCase c arity arity0 =
+      jVar (\rs newAp ->
+              mconcat [ rs |= (arity .>>. 8)
+                      , loadRegs rs
+                      , sp |= sp - rs
+                      , newAp |= (var "h$apply" .! (toJExpr n-arity0.|.((toJExpr r-rs).<<.8)))
+                      , stack .! sp |= newAp
+                      , profStat s pushRestoreCCS
+                      , traceRts s (toJExpr (funcName <> ": new stack frame: ") + (newAp .^ "n"))
+                      , returnS c
+                      ])
+      where
+        loadRegs rs = SwitchStat rs switchAlts mempty
+          where
+            switchAlts = map (\x -> (toJExpr x, toJExpr (intToJSReg (x+1)) |= stack .! (sp - toJExpr x))) [r,r-1..1]
+
+{-
+  stg_ap_r_n_fast is entered if a function of unknown arity
+  is called, n arguments are already in r registers
+-}
+fastApply :: StgToJSConfig -> Int -> Int -> JStat
+fastApply s r n = func ||= toJExpr (JFunc myFunArgs body)
+    where
+      funName = pack ("h$ap_" ++ show n ++ "_" ++ show r ++ "_fast")
+      func    = TxtI funName
+
+      myFunArgs = []
+
+      regArgs = take r (enumFrom R2)
+
+      mkAp :: Int -> Int -> [JExpr]
+      mkAp n' r' = [ var . pack $ "h$ap_" ++ show n' ++ "_" ++ show r' ]
+
+      body =
+        jVar $ \c farity arity ->
+        mconcat [ c |= r1 .^ "f"
+                , traceRts s (toJExpr (funName <> ": sp ") + sp)
+                -- TODO: Jeff (2022,03): factor our and dry out this code
+                , SwitchStat (c .^ "t")
+                   [(toJExpr Fun, traceRts s (toJExpr (funName <> ": ")
+                                              + clName c
+                                              + jString " (arity: " + (c .^ "a") + jString ")")
+                                  <> (farity |= funArity' c)
+                                  <> funCase c farity)
+                   ,(toJExpr Pap, traceRts s (toJExpr (funName <> ": pap")) <> (arity |= papArity r1) <> funCase c arity)
+                   ,(toJExpr Thunk, traceRts s (toJExpr (funName <> ": thunk")) <> push' s (reverse (map toJExpr $ take r (enumFrom R2)) ++ mkAp n r) <> profStat s pushRestoreCCS <> returnS c)
+                   ,(toJExpr Blackhole, traceRts s (toJExpr (funName <> ": blackhole")) <> push' s (reverse (map toJExpr $ take r (enumFrom R2)) ++ mkAp n r) <> push' s [r1, var "h$return"] <> returnS (app "h$blockOnBlackhole" [r1]))]
+                   (appS "throw" [toJExpr (funName <> ": unexpected closure type: ") + c .^ "t"])
+                ]
+
+      funCase :: JExpr -> JExpr -> JStat
+      funCase c arity = jVar $
+        \arg ar -> case arg of
+          ValExpr (JVar pap) -> (ar |= mask8 arity)
+                                  <> ifS (toJExpr n .===. ar)
+                                  -- then
+                                  (traceRts s (toJExpr (funName <> ": exact")) <> returnS c)
+                                  -- else
+                                  (ifS (toJExpr n .>. ar)
+                                    --then
+                                    (traceRts s (toJExpr (funName <> ": oversat")) <> oversatCase c arity)
+                                    -- else
+                                    (traceRts s (toJExpr (funName <> ": undersat"))
+                                     <> mkPap s pap r1 (toJExpr n) (map toJExpr regArgs)
+                                     <> (r1 |= toJExpr pap)
+                                     <> returnStack))
+          _             -> mempty -- FIXME: Jeff (2022,03), just quieting non-exhaustive
+                                  -- patterns. That the code wants to do this
+                                  -- means we should be encoding that funCase is
+                                  -- only callable on ValExpr (JVar pap)'s in
+                                  -- the type system, perhaps with a GADT or
+                                  -- phantom
+
+      oversatCase :: JExpr -> JExpr -> JStat
+      oversatCase c arity =
+         jVar $ \rs rsRemain ->
+                  mconcat [ rs |= arity .>>. 8
+                          , rsRemain |= toJExpr r - rs
+                          , traceRts s (toJExpr
+                                        (funName <> " regs oversat ")
+                                         + rs
+                                         + jString " remain: "
+                                         + rsRemain)
+                          , saveRegs rs
+                          , sp |= sp + rsRemain + 1
+                          , stack .! sp |= var "h$apply" .! ((rsRemain.<<.8).|. toJExpr n - mask8 arity)
+                          , profStat s pushRestoreCCS
+                          , returnS c
+                          ]
+          where
+            saveRegs n = SwitchStat n switchAlts mempty
+              where
+                switchAlts = map (\x -> (toJExpr x, stack .! (sp + toJExpr (r-x)) |= toJExpr (intToJSReg (x+2)))) [0..r-1]
+
+zeroApply :: StgToJSConfig -> JStat
+zeroApply s =
+  mconcat [ TxtI "h$ap_0_0_fast" ||= jLam (enter s r1)
+          , closure (ClosureInfo "h$ap_0_0" (CIRegs 0 [PtrV]) "h$ap_0_0" (CILayoutFixed 0 []) CIStackFrame mempty)
+            (adjSpN' 1 <> enter s r1)
+          , TxtI "h$e" ||= jLam (\c -> (r1 |= c) <> enter s c)
+          ]
+
+-- carefully enter a closure that might be a thunk or a function
+
+-- ex may be a local var, but must've been copied to R1 before calling this
+enter :: StgToJSConfig -> JExpr -> JStat
+enter s ex =
+         jVar $ \c ->
+                  mconcat [ jwhenS (app "typeof" [ex] .!==. jTyObject) returnStack
+                          , c |= ex .^ "f"
+                          , jwhenS (c .===. var "h$unbox_e") ((r1 |= ex .^ "d1") <> returnStack)
+                          , SwitchStat (c .^ "t")
+                            [ (toJExpr Con, mempty)
+                            , (toJExpr Fun, mempty)
+                            , (toJExpr Pap, returnStack)
+                            , (toJExpr Blackhole, push' s [var "h$ap_0_0", ex, var "h$return"]
+                                <> returnS (app "h$blockOnBlackhole" [ex]))
+                            ] (returnS c)
+                          ]
+
+updates :: StgToJSConfig -> JStat
+updates s =
+  closure (ClosureInfo "h$upd_frame" (CIRegs 0 [PtrV]) "h$upd_frame" (CILayoutFixed 1 [PtrV]) CIStackFrame mempty)
+        (jVar $ \updatee waiters ss si sir ->
+            mconcat [ updatee |= stack .! (sp - 1)
+                    , traceRts s (jString "h$upd_frame updatee alloc: " + updatee .^ "alloc")
+                    , -- wake up threads blocked on blackhole
+                      waiters |= updatee .^ "d2"
+                    , jwhenS (waiters .!==. null_)
+                                (loop 0 (.<. waiters .^ "length")
+                                   (\i -> appS "h$wakeupThread" [waiters .! i] <> postIncrS i))
+                    , -- update selectors
+                      jwhenS ((app "typeof" [updatee .^ "m"] .===. jTyObject) .&&. (updatee .^ "m" .^ "sel"))
+                      ((ss |= updatee .^ "m" .^ "sel")
+                        <> loop 0 (.<. ss .^ "length")
+                        (\i -> mconcat [ si |= ss .! i
+                                       , sir |= (si .^ "d2") `ApplExpr` [r1]
+                                       , ifS (app "typeof" [sir] .===. jTyObject)
+                                                (mconcat [ si .^ "f"  |= sir .^ "f"
+                                                         , si .^ "d1" |= sir .^ "d1"
+                                                         , si .^ "d2" |= sir .^ "d2"
+                                                         , si .^ "m"  |= sir .^ "m"
+                                                         ])
+                                                (mconcat [ si .^ "f"  |= var "h$unbox_e"
+                                                         , si .^ "d1" |= sir
+                                                         , si .^ "d2" |= null_
+                                                         , si .^ "m"  |= 0
+                                                         ])
+                                       , postIncrS i
+                                       ]))
+                    , -- overwrite the object
+                      ifS (app "typeof" [r1] .===. jTyObject)
+                          (mconcat [ traceRts s (jString "$upd_frame: boxed: " + ((r1 .^ "f") .^ "n"))
+                                   , updatee .^ "f"  |= r1 .^ "f"
+                                   , updatee .^ "d1" |= r1 .^ "d1"
+                                   , updatee .^ "d2" |= r1 .^ "d2"
+                                   , updatee .^ "m"  |= r1 .^ "m"
+                                   , profStat s (updateCC updatee)
+                                   ])
+                          (mconcat [ updatee .^ "f" |= var "h$unbox_e"
+                                   , updatee .^ "d1" |= r1
+                                   , updatee .^ "d2" |= null_
+                                   , updatee .^ "m" |= 0
+                                   , profStat s (updateCC updatee)
+                                   ])
+                    , adjSpN' 2
+                    , traceRts s (jString "h$upd_frame: updating: "
+                                  + updatee
+                                  + jString " -> "
+                                  + r1)
+                    , returnStack
+                    ])
+   <>
+   closure (ClosureInfo "h$upd_frame_lne" (CIRegs 0 [PtrV]) "h$upd_frame_lne" (CILayoutFixed 1 [PtrV]) CIStackFrame mempty)
+           (jVar $ \updateePos ->
+            (updateePos |= stack .! (sp - 1))
+            <> (stack .! updateePos |= r1)
+            <> adjSpN' 2
+            <> traceRts s (jString "h$upd_frame_lne: updating: "
+                           + updateePos
+                           + jString " -> "
+                           + r1)
+            <> returnStack)
+  where
+    updateCC updatee = updatee .^ "cc" |= jCurrentCCS
+
+selectors :: StgToJSConfig -> JStat
+selectors s =
+  mkSel "1"   (.^ "d1")
+  <> mkSel "2a"  (.^ "d2")
+  <> mkSel "2b"  (\x -> x .^ "d2" .^ "d1")
+  <> mconcat (map mkSelN [3..16])
+   where
+    mkSelN :: Int -> JStat
+    mkSelN x = mkSel (pack $ show x)
+                     (\e -> SelExpr (SelExpr (toJExpr e) (TxtI (pack "d2"))){-[je| `toJExpr`.d2 |]-}
+                            (TxtI $ pack ("d" ++ show (x-1))))
+
+
+    mkSel :: ShortText -> (JExpr -> JExpr) -> JStat
+    mkSel name sel =
+      mconcat [TxtI createName ||= jLam (\r -> traceRts s (toJExpr ("selector create: " <> name <> " for ") + (r .^ "alloc"))
+                                        <> ifS (isThunk r .||. isBlackhole r)
+                                          (returnS (app "h$mkSelThunk" [r, toJExpr (v entryName), toJExpr (v resName)]))
+                                          (returnS (sel r)))
+              , TxtI resName ||= jLam (\r -> traceRts s (toJExpr ("selector result: " <> name <> " for ") + (r .^ "alloc"))
+                                        <> returnS (sel r))
+              , closure (ClosureInfo entryName (CIRegs 0 [PtrV]) ("select " <> name) (CILayoutFixed 1 [PtrV]) CIThunk mempty)
+                (jVar $ \tgt ->
+                 (tgt |= r1 .^ "d1")
+                 <> traceRts s (toJExpr ("selector entry: " <> name <> " for ") + (tgt .^ "alloc"))
+                 <> ifS (isThunk tgt .||. isBlackhole tgt)
+                 (preIncrS sp
+                  <> (stack .! sp |= var frameName)
+                  <> returnS (app "h$e" [tgt]))
+                  (returnS (app "h$e" [sel tgt])))
+              , closure
+                (ClosureInfo frameName (CIRegs 0 [PtrV]) ("select " <> name <> " frame") (CILayoutFixed 0 []) CIStackFrame mempty)
+                $ mconcat [ traceRts s (toJExpr ("selector frame: " <> name))
+                          , postDecrS sp
+                          , returnS (app "h$e" [sel r1])
+                          ]
+              ]
+
+      where
+         v x   = JVar (TxtI x)
+         n ext =  "h$c_sel_" <> name <> ext
+         createName = n ""
+         resName    = n "_res"
+         entryName  = n "_e"
+         frameName  = n "_frame_e"
+
+
+{-
+  Partial applications. There are two different kinds of partial application:
+    pap_r contains r registers, pap_gen can contain any number
+
+    layout:
+     - d1      = function
+     - d2.d1 & 0xff = number of args
+       d2.d1 >> 8   = number of registers (r for h$pap_r)
+     - d2.d2.. = args (r)
+-}
+-- arity is the remaining arity after our supplied arguments are applied
+mkPap :: StgToJSConfig
+      -> Ident   -- ^ id of the pap object
+      -> JExpr   -- ^ the function that's called (can be a second pap)
+      -> JExpr   -- ^ number of arguments in pap
+      -> [JExpr] -- ^ values for the supplied arguments
+      -> JStat
+mkPap s tgt fun n values =
+      traceRts s (toJExpr $ "making pap with: " ++ show (length values) ++ " items")
+      `mappend`
+      allocDynamic s True tgt (toJExpr entry) (fun:papAr:map toJExpr values')
+        (if csProf s then Just jCurrentCCS else Nothing)
+  where
+    papAr = funOrPapArity fun Nothing - toJExpr (length values * 256) - n
+
+    values' | GHC.Prelude.null values = [null_]
+            | otherwise   = values
+    entry | length values > numSpecPap = TxtI "h$pap_gen"
+          | otherwise                  = TxtI . pack $ "h$pap_" ++ show (length values)
+
+-- specialized (faster) pap generated for [0..numSpecPap]
+-- others use h$pap_gen
+specPap :: [Int]
+specPap = [0..numSpecPap]
+
+numSpecPap :: Int
+numSpecPap = 6
+
+pap :: StgToJSConfig
+    -> Int
+    -> JStat
+pap s r = closure (ClosureInfo funcName CIRegsUnknown funcName (CILayoutUnknown (r+2)) CIPap mempty) body
+  where
+    funcName = pack ("h$pap_" ++ show r)
+
+    body =
+      jVar $ \c d f extra ->
+          mconcat [ c |= r1 .^ "d1"
+                  , d |= r1 .^ "d2"
+                  , f |= c  .^ "f"
+                  , assertRts s (isFun' f .||. isPap' f) (funcName <> ": expected function or pap")
+                  , profStat s (enterCostCentreFun currentCCS)
+                  , extra |= (funOrPapArity c (Just f) .>>. 8) - toJExpr r
+                  , traceRts s (toJExpr (funcName <> ": pap extra args moving: ") + extra)
+                  , moveBy extra
+                  , loadOwnArgs d
+                  , r1 |= c
+                  , returnS f
+                  ]
+    moveBy extra = SwitchStat extra
+                   (reverse $ map moveCase [1..maxReg-r-1]) mempty
+    moveCase m = (toJExpr m, toJExpr (intToJSReg (m+r+1)) |= toJExpr (intToJSReg (m+1)))
+    loadOwnArgs d = mconcat $ map (\r ->
+        toJExpr (intToJSReg (r+1)) |= dField d (r+2)) [1..r]
+    dField d n = SelExpr d (TxtI . pack $ ('d':show (n-1)))
+
+-- Construct a generic PAP
+papGen :: StgToJSConfig -> JStat
+papGen cfg =
+   closure (ClosureInfo funcName CIRegsUnknown funcName CILayoutVariable CIPap mempty)
+           (jVar $ \c f d pr or r ->
+                        mconcat [ c |= r1 .^ "d1"
+                                , f |= c  .^ "f"
+                                , d |= r1 .^ "d2"
+                                , pr |= funOrPapArity c (Just f) .>>. 8
+                                , or |= papArity r1 .>>. 8
+                                , r |= pr - or
+                                , assertRts cfg
+                                  (isFun' f .||. isPap' f)
+                                  (jString "h$pap_gen: expected function or pap")
+                                , profStat cfg (enterCostCentreFun currentCCS)
+                                , traceRts cfg (jString "h$pap_gen: generic pap extra args moving: " + or)
+                                , appS "h$moveRegs2" [or, r]
+                                , loadOwnArgs d r
+                                , r1 |= c
+                                , returnS f
+                                ])
+
+
+  where
+    funcName = "h$pap_gen"
+    loadOwnArgs d r =
+      let prop n = d .^ ("d" <> pack (show $ n+1))
+          loadOwnArg n = (toJExpr n, toJExpr (intToJSReg (n+1)) |= prop n)
+      in  SwitchStat r (map loadOwnArg [127,126..1]) mempty
+
+-- general utilities
+-- move the first n registers, starting at R2, m places up (do not use with negative m)
+-- FIXME (Jeff, 2022/03): pick a better name, e.g., `r2moveRegs`
+moveRegs2 :: JStat
+moveRegs2 = TxtI "h$moveRegs2" ||= jLam moveSwitch
+  where
+    moveSwitch n m = SwitchStat ((n .<<. 8) .|. m) switchCases (defaultCase n m)
+    -- fast cases
+    -- TODO: tune the parameteters for performance and size
+    switchCases = [switchCase n m | n <- [1..5], m <- [1..4]]
+    switchCase :: Int -> Int -> (JExpr, JStat)
+    switchCase n m = (toJExpr $
+                      (n `Bits.shiftL` 8) Bits..|. m
+                     , mconcat (map (`moveRegFast` m) [n+1,n..2])
+                       <> BreakStat Nothing {-[j| break; |]-})
+    moveRegFast n m = toJExpr (intToJSReg (n+m)) |= toJExpr (intToJSReg n)
+    -- fallback
+    defaultCase n m =
+      loop n (.>.0) (\i -> appS "h$setReg" [i+1+m, app "h$getReg" [i+1]] `mappend` postDecrS i)
+
+
+-- Initalize a variable sized object from an array of values
+initClosure :: StgToJSConfig -> JExpr -> JExpr -> JExpr -> JExpr
+initClosure cfg entry values ccs
+  | csProf cfg =
+      app "h$init_closure" [ toJExpr (jhFromList [ ("f" , entry)
+                                                 , ("d1", null_)
+                                                 , ("d2", null_)
+                                                 , ("m" , 0)
+                                                 , ("cc", ccs)])
+                           , values]
+  | otherwise =
+      app "h$init_closure" [ toJExpr (jhFromList [ ("f" , entry)
+                                                 , ("d1", null_)
+                                                 , ("d2", null_)
+                                                 , ("m" , 0)])
+                           , values]
+
+
+-- FIXME: where to put this
+closure :: ClosureInfo -- ^ object being info'd see @ciVar@ in @ClosureInfo@
+        -> JStat       -- ^ rhs
+        -> JStat
+closure ci body = (TxtI (ciVar ci)||= jLam body) `mappend` toStat ci
+
+-- FIXME: where to put this
+conClosure :: ShortText -> ShortText -> CILayout -> Int -> JStat
+conClosure symbol name layout constr =
+  closure (ClosureInfo symbol (CIRegs 0 [PtrV]) name layout (CICon constr) mempty)
+          (returnS (stack .! sp))
diff --git a/compiler/GHC/JS/Rts/Rts.hs b/compiler/GHC/JS/Rts/Rts.hs
new file mode 100644
index 0000000000..b0ba541806
--- /dev/null
+++ b/compiler/GHC/JS/Rts/Rts.hs
@@ -0,0 +1,668 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+{-# OPTIONS_GHC -O0 #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.JS.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>
+-- 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...
+--
+-- FIXME: Jeff (2022,03): Finish module description. Specifically:
+-- 1. Since this is the top level module for the RTS, what is the architecture
+-- of the RTS? How does it all hold together? Describe the memory layout, any
+-- other tricks the RTS plays, and relevant sibling modules
+--
+-----------------------------------------------------------------------------
+
+module GHC.JS.Rts.Rts where
+
+import GHC.JS.Syntax
+import GHC.JS.Make
+import GHC.JS.Transform
+
+import GHC.StgToJS.Heap
+import GHC.StgToJS.Monad
+import GHC.StgToJS.Profiling
+import GHC.StgToJS.Regs
+import GHC.StgToJS.Types
+import GHC.JS.Rts.Apply
+
+import qualified GHC.Data.ShortText as T
+
+import Data.Array
+import Data.Char (toLower, toUpper)
+import qualified Data.Bits          as Bits
+import qualified Data.Map           as M
+
+import           Prelude
+
+-----------------------------------------------------------------------------
+--
+-- Pre-generated RTS for the JS backend
+--
+-- TODO: Jeff (2022,03):
+
+-- 1. There are numerous string literals sprinkled throughout the RTS, these
+-- should be moved and isolated into a single module and then used throughout
+-- the RTS and StgToJS Pipeline
+--
+-- 2. The RTS makes a lot of use of the Monoid instances on lists since the
+-- Haskell portion is essentially building a JavaScript AST for the JS Rts and
+-- then pretty printing it so it can be used by the js backend. However, all
+-- this merging on lists is going to be extremely inefficient. (++) is O(n^2)
+-- and furthermore we have nested list structures. This implies a better data
+-- structure with an emphasis on fast merging is likely to reduce compile times
+-- for this RTS.
+--
+-- 3. Similar to (2), most of the RTS is a function foo :: <something> with
+-- definition foo [...<something>...] = mconcat ...<the body is JS land>... This
+-- is fine, however it implies a monadic design for this EDSL might lead to more
+-- readable code. Or in other words, `mconcat` and friends are just boiler
+-- plate, and what we really have is a monadic EDSL where the monad is a kind of
+-- Writer monad. Which we have essentially recreated here since bind in the
+-- Writer monad is mapConcat and you'll notice that most of the functions in the
+-- RTS do exactly that, i.e., apply a function which generates a list, then
+-- concats. So we are dealing with a Writer monad but aren't using Haskell's
+-- language facilities to be explicit about it. Hence all the boilerplate. Side
+-- note, we might also consider two alternative approaches if we go with a
+-- monadic design:
+-- -- a. Continuation passing style so that intermediate lists fuse
+-- -- b. A writer monad with a difference list, this would essentially be a
+-- -- zipper but whether it is worth it or not depend on how often children need
+-- -- to access their siblings, if they do that a lot then we'll have huge
+-- -- speedups, if not then we likely won't gain anything
+
+-----------------------------------------------------------------------------
+
+garbageCollector :: JStat
+garbageCollector =
+  mconcat [ TxtI "h$resetRegisters"  ||= jLam (mconcat $ map resetRegister [minBound..maxBound])
+          , TxtI "h$resetResultVars" ||= jLam (mconcat $ map resetResultVar [minBound..maxBound])
+          ]
+
+
+resetRegister :: StgReg -> JStat
+resetRegister r = toJExpr r |= null_
+
+resetResultVar :: StgRet -> JStat
+resetResultVar r = toJExpr r |= null_
+
+{-
+  use h$c1, h$c2, h$c3, ... h$c24 instead of making objects manually so layouts
+  and fields can be changed more easily
+ -}
+closureConstructors :: StgToJSConfig -> JStat
+closureConstructors s =
+     declClsConstr "h$c"  ["f"] [var "f", null_, null_, 0]
+  <> declClsConstr "h$c0" ["f"] [var "f", null_, null_, 0] -- FIXME: same as h$c, maybe remove one of them?
+  <> declClsConstr "h$c1" ["f", "x1"] [var "f", var "x1", null_, 0]
+  <> declClsConstr "h$c2" ["f", "x1", "x2"] [var "f", var "x1", var "x2", 0]
+  <> mconcat (map mkClosureCon [3..24])
+  <> mconcat (map mkDataFill [1..24])
+  where
+    prof = csProf s
+    addCCArg as = map TxtI $ as ++ ["cc" | prof]
+    addCCArg' as = as ++ [TxtI "cc" | prof]
+    addCCField fs = jhFromList $ fs ++ [("cc", var "cc") | prof]
+
+    declClsConstr i as fs = TxtI i ||= ValExpr (JFunc (addCCArg as)
+      ( jVar $ \x ->
+          mconcat [ checkC
+                  , x |= toJExpr (addCCField $ zip ["f", "d1", "d2", "m"] fs)
+                  , notifyAlloc x
+                  , traceAlloc x
+                  , returnS x
+                  ]
+         ))
+
+    traceAlloc x | csTraceRts s = appS "h$traceAlloc" [x]
+                 | otherwise    = mempty
+
+    notifyAlloc x | csDebugAlloc s = appS "h$debugAlloc_notifyAlloc" [x]
+                  | otherwise      = 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 | csAssertRts s =
+      jVar $ \msg ->
+      jwhenS (var "arguments" .! 0 .!==. jString "h$ghcjszmprimZCGHCJSziPrimziJSVal_con_e")
+                                  (loop 1 (.<. var "arguments" .^ "length")
+                                          (\i ->
+                                             mconcat [msg |= jString "warning: undefined or null in argument: "
+                                                       + i
+                                                       + jString " allocating closure: " + (var "arguments" .! 0 .^ "n")
+                                                     , appS "h$log" [msg]
+                                                     , jwhenS (var "console" .&&. (var "console" .^ "trace")) ((var "console" .^ "trace") `ApplStat` [msg])
+                                                     , postIncrS i
+                                                     ])
+
+                                  )
+           | otherwise = 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 | csAssertRts s =
+                     loop 0 (.<. var "arguments" .^ "length")
+                     (\i -> jwhenS ((var "arguments" .! i .===. null_)
+                                    .||. (var "arguments" .! i .===. undefined_))
+                            (jVar $ \msg ->
+                                mconcat [ msg |= jString "warning: undefined or null in argument: " + i + jString " allocating fields"
+                                        , jwhenS (var "console" .&&. (var "console" .^ "trace"))
+                                                ((var "console" .^ "trace") `ApplStat` [msg])
+                                        ]))
+
+           | otherwise = mempty
+
+    mkClosureCon :: Int -> JStat
+    mkClosureCon n = let funName = TxtI $ T.pack ("h$c" ++ show n)
+                         vals   = TxtI "f" : addCCArg' (map (TxtI . T.pack . ('x':) . show) [(1::Int)..n])
+                         fun    = JFunc vals funBod
+                         funBod =
+                           jVar $ \x ->
+                           mconcat [ checkC
+                                   , x |= toJExpr (addCCField [("f", var "f"), ("d1", var "x1"), ("d2", toJExpr obj), ("m", 0)])
+                                   , notifyAlloc x
+                                   , traceAlloc x
+                                   , returnS x
+                                   ]
+
+                         -- TODO: Jeff (2022,03): comment on the meaning of
+                         -- [1..] and [2..n], I suppose this means that 0, and
+                         -- 0,1,2 are reserved?
+                         obj    = JHash . M.fromList $ zip
+                                    (map (T.pack . ('d':) . show) [(1::Int)..])
+                                    (map (toJExpr . TxtI . T.pack . ('x':) . show) [2..n])
+                     in funName ||= toJExpr fun
+
+    mkDataFill :: Int -> JStat
+    mkDataFill n = let funName = TxtI $ T.pack ("h$d" ++ show n)
+                       ds      = map (T.pack . ('d':) . show) [(1::Int)..n]
+                       obj     = JHash . M.fromList . zip ds $ map (toJExpr . TxtI) ds
+                       fun     = JFunc (map TxtI ds) (checkD <>  returnS (toJExpr obj))
+                   in funName ||= toJExpr fun
+
+stackManip :: JStat
+stackManip = mconcat (map mkPush [1..32]) <>
+             mconcat (map mkPpush [1..255])
+  where
+    mkPush :: Int -> JStat
+    mkPush n = let funName = TxtI $ T.pack ("h$p" ++ show n)
+                   as      = map (TxtI . T.pack . ('x':) . show) [1..n]
+                   fun     = JFunc as ((sp |= sp + toJExpr n)
+                                       <> mconcat (zipWith (\i a -> stack .! (sp - toJExpr (n-i)) |= toJExpr a)
+                                                   [1..] as))
+               in funName ||= toJExpr fun
+
+    -- | partial pushes, based on bitmap, increases Sp by highest bit
+    mkPpush :: Integer -> JStat
+    mkPpush sig | sig Bits..&. (sig+1) == 0 = mempty -- already handled by h$p
+    mkPpush sig = let funName = TxtI $ T.pack ("h$pp" ++ show sig)
+                      bits    = bitsIdx sig
+                      n       = length bits
+                      h       = last bits
+                      args    = map (TxtI . T.pack . ('x':) . show) [1..n]
+                      fun     = JFunc args $
+                        mconcat [ sp |= sp + toJExpr (h+1)
+                                , mconcat (zipWith (\b a -> stack .! (sp - toJExpr (h-b)) |= toJExpr a) bits args)
+                                ]
+                   in funName ||= toJExpr fun
+
+bitsIdx :: Integer -> [Int]
+bitsIdx n | n < 0 = error "bitsIdx: negative"
+          | otherwise = go n 0
+  where
+    go 0 _ = []
+    go m b | Bits.testBit m b = b : go (Bits.clearBit m b) (b+1)
+           | otherwise   = go (Bits.clearBit m b) (b+1)
+
+bhLneStats :: StgToJSConfig -> JExpr -> JExpr -> JStat
+bhLneStats _s p frameSize =
+   jVar $ \v ->
+            mconcat [ v |= stack .! p
+                    , ifS v
+                      ((sp |= sp - frameSize)
+                       <> ifS (v .===. var "h$blackhole")
+                                (returnS $ app "h$throw" [var "h$baseZCControlziExceptionziBasezinonTermination", false_])
+                                (mconcat [r1 |= v
+                                         , sp |= sp - frameSize
+                                         , returnStack
+                                         ]))
+                      ((stack .! p |= var "h$blackhole") <> returnS null_)
+                    ]
+
+
+-- FIXME move somewhere else
+declRegs :: JStat
+-- FIXME prevent holes
+declRegs =
+  mconcat [ TxtI "h$regs" ||= toJExpr (JList [])
+          , mconcat (map declReg (enumFromTo R1 R32))
+          , regGettersSetters
+          , loadRegs
+          ]
+    where
+      declReg r = (decl . TxtI . T.pack . ("h$"++) . map toLower . show) r
+                  <> BlockStat [AssignStat (toJExpr r) (ValExpr (JInt 0))] -- [j| `r` = 0; |]
+
+regGettersSetters :: JStat
+regGettersSetters =
+  mconcat [ TxtI "h$getReg" ||= jLam (\n   -> SwitchStat n getRegCases mempty)
+          , TxtI "h$setReg" ||= jLam (\n v -> SwitchStat n (setRegCases v) mempty)
+          ]
+  where
+    getRegCases =
+      map (\r -> (toJExpr (jsRegToInt r) , returnS (toJExpr r))) (enumFrom R1)
+    setRegCases v =
+      map (\r -> (toJExpr (jsRegToInt r), (toJExpr r |= toJExpr v) <> returnS undefined_)) (enumFrom R1)
+
+loadRegs :: JStat
+loadRegs = mconcat $ map mkLoad [1..32]
+  where
+    mkLoad :: Int -> JStat
+    mkLoad n = let args   = map (TxtI . T.pack . ("x"++) . show) [1..n]
+                   assign = zipWith (\a r -> toJExpr r |= toJExpr a)
+                                -- FIXME: Jeff (2022,03) the use of reverse,
+                                -- take, and enumFrom here heavily implies
+                                -- Data.Sequence would be a better data
+                                -- structure to hold the regs. Or perhaps we
+                                -- steal the indices from the registers array?
+                                -- Either way we can avoid allocating this
+                                -- intermediate `enumFrom R1` list
+                              args (reverse $ take n (enumFrom R1))
+                   fname  = TxtI $ T.pack ("h$l" ++ show n)
+                   fun    = JFunc args (mconcat assign)
+               in fname ||= toJExpr fun
+
+-- assign registers R1 ... Rn
+-- assigns Rn first
+assignRegs :: StgToJSConfig -> [JExpr] -> JStat
+assignRegs _ [] = mempty
+assignRegs s xs
+  | l <= 32 && not (csInlineLoadRegs s)
+      = ApplStat (ValExpr (JVar $ assignRegs'!l)) (reverse xs)
+  | otherwise = mconcat . reverse $
+      zipWith (\r ex -> toJExpr r |= ex) (take l $ enumFrom R1) xs
+  where
+    l = length xs
+
+assignRegs' :: Array Int Ident
+assignRegs' = listArray (1,32) (map (TxtI . T.pack . ("h$l"++) . show) [(1::Int)..32])
+
+declRets :: JStat
+declRets = mconcat $ map (decl . TxtI . T.pack . ("h$"++) . map toLower . show) (enumFrom Ret1)
+
+trace :: ToJExpr a => a -> JStat
+trace ex = appS "h$log" [toJExpr ex]
+
+closureTypes :: JStat
+closureTypes = mconcat (map mkClosureType (enumFromTo minBound maxBound)) <> closureTypeName
+  where
+    mkClosureType :: ClosureType -> JStat
+    mkClosureType c = let s = TxtI . T.pack $ "h$" ++ map toUpper (show c) ++ "_CLOSURE"
+                      in  s ||= toJExpr c
+    closureTypeName :: JStat
+    closureTypeName =
+      TxtI "h$closureTypeName" ||= jLam (\c ->
+                                           mconcat (map (ifCT c) [minBound..maxBound])
+                                          <> returnS (jString "InvalidClosureType"))
+
+    ifCT :: JExpr -> ClosureType -> JStat
+    ifCT arg ct = jwhenS (arg .===. toJExpr ct) (returnS (toJExpr (show ct)))
+
+rtsDecls :: JStat
+rtsDecls = jsSaturate (Just "h$RTSD") $
+  mconcat [ TxtI "h$currentThread"   ||= null_                   -- thread state object for current thread
+          , TxtI "h$stack"           ||= null_                   -- stack for the current thread
+          , TxtI "h$sp"              ||= 0                       -- stack pointer for the current thread
+          , TxtI "h$initStatic"      ||= toJExpr (JList [])      -- we need delayed initialization for static objects, push functions here to be initialized just before haskell runs
+          , TxtI "h$staticThunks"    ||= toJExpr (jhFromList []) --  funcName -> heapidx map for srefs
+          , TxtI "h$staticThunksArr" ||= toJExpr (JList [])      -- indices of updatable thunks in static heap
+          -- stg registers
+          , declRegs
+          , declRets]
+
+rts :: StgToJSConfig -> JStat
+rts = jsSaturate (Just "h$RTS") . rts'
+
+rts' :: StgToJSConfig -> JStat
+rts' s =
+  mconcat [ closureConstructors s
+          , garbageCollector
+          , stackManip
+          -- settings (FIXME should be const)
+          , TxtI "h$rts_traceForeign" ||= toJExpr (csTraceForeign s)
+          , TxtI "h$rts_profiling"    ||= toJExpr (csProf s)
+          -- closure types (FIXME should be const)
+          , TxtI "h$ct_fun"        ||= toJExpr Fun
+          , TxtI "h$ct_con"        ||= toJExpr Con
+          , TxtI "h$ct_thunk"      ||= toJExpr Thunk
+          , TxtI "h$ct_pap"        ||= toJExpr Pap
+          , TxtI "h$ct_blackhole"  ||= toJExpr Blackhole
+          , TxtI "h$ct_stackframe" ||= toJExpr StackFrame
+          -- var / closure field types (FIXME should be const)
+          , TxtI "h$vt_ptr"    ||= toJExpr PtrV
+          , TxtI "h$vt_void"   ||= toJExpr VoidV
+          , TxtI "h$vt_double" ||= toJExpr IntV
+          , TxtI "h$vt_long"   ||= toJExpr LongV
+          , TxtI "h$vt_addr"   ||= toJExpr AddrV
+          , TxtI "h$vt_rtsobj" ||= toJExpr RtsObjV
+          , TxtI "h$vt_obj"    ||= toJExpr ObjV
+          , TxtI "h$vt_arr"    ||= toJExpr ArrV
+          , TxtI "h$bh"        ||= jLam (bhStats s True)
+          , TxtI "h$bh_lne"    ||= jLam (\x frameSize -> bhLneStats s x frameSize)
+          , closure (ClosureInfo "h$blackhole" (CIRegs 0 []) "blackhole" (CILayoutUnknown 2) CIBlackhole mempty)
+               (appS "throw" [jString "oops: entered black hole"])
+          , closure (ClosureInfo "h$blackholeTrap" (CIRegs 0 []) "blackhole" (CILayoutUnknown 2) CIThunk mempty)
+               (appS "throw" [jString "oops: entered multiple times"])
+          , closure (ClosureInfo "h$done" (CIRegs 0 [PtrV]) "done" (CILayoutUnknown 0) CIStackFrame mempty)
+               (appS "h$finishThread" [var "h$currentThread"] <> returnS (var "h$reschedule"))
+          , closure (ClosureInfo "h$doneMain_e" (CIRegs 0 [PtrV]) "doneMain" (CILayoutUnknown 0) CIStackFrame mempty)
+               (returnS (var "h$doneMain"))
+          , conClosure "h$false_e" "GHC.Types.False" (CILayoutFixed 0 []) 1
+          , conClosure "h$true_e"  "GHC.Types.True"  (CILayoutFixed 0 []) 2
+          , conClosure "h$integerzmwiredzminZCGHCziIntegerziTypeziSzh_con_e" "GHC.Integer.Type.S#" (CILayoutFixed 1 [IntV]) 1
+          , conClosure "h$integerzmwiredzminZCGHCziIntegerziTypeziJpzh_con_e" "GHC.Integer.Type.Jp#" (CILayoutFixed 1 [ObjV]) 2
+          , conClosure "h$integerzmwiredzminZCGHCziIntegerziTypeziJnzh_con_e" "GHC.Integer.Type.Jn#" (CILayoutFixed 1 [ObjV]) 3
+          -- generic data constructor with 1 non-heapobj field
+          , conClosure "h$data1_e" "data1" (CILayoutFixed 1 [ObjV]) 1
+          -- generic data constructor with 2 non-heapobj fields
+          , conClosure "h$data2_e" "data2" (CILayoutFixed 2 [ObjV,ObjV]) 1
+          , closure (ClosureInfo "h$noop_e" (CIRegs 1 [PtrV]) "no-op IO ()" (CILayoutFixed 0 []) (CIFun 1 0) mempty)
+               (returnS (stack .! sp))
+            <> (TxtI "h$noop" ||= ApplExpr (var "h$c0") (var "h$noop_e" : [jSystemCCS | csProf s]))
+          , closure (ClosureInfo "h$catch_e" (CIRegs 0 [PtrV]) "exception handler" (CILayoutFixed 2 [PtrV,IntV]) CIStackFrame mempty)
+               (adjSpN' 3 <> returnS (stack .! sp))
+          , closure (ClosureInfo "h$dataToTag_e" (CIRegs 0 [PtrV]) "data to tag" (CILayoutFixed 0 []) CIStackFrame mempty)
+                $ mconcat [ r1 |= if_ (r1 .===. true_) 1 (if_ (typeof r1 .===. jTyObject) (r1 .^ "f" .^ "a" - 1) 0)
+                          , adjSpN' 1
+                          , returnS (stack .! sp)
+                          ]
+          -- function application to one argument
+          , closure (ClosureInfo "h$ap1_e" (CIRegs 0 [PtrV]) "apply1" (CILayoutFixed 2 [PtrV, PtrV]) CIThunk mempty)
+               (jVar $ \d1 d2 ->
+                   mconcat [ d1 |= r1 .^ "d1"
+                           , d2 |= r1 .^ "d2"
+                           , appS "h$bh" []
+                           , profStat s enterCostCentreThunk
+                           , r1 |= d1
+                           , r2 |= d2
+                           , returnS (app "h$ap_1_1_fast" [])
+                           ])
+          -- function application to two arguments
+          , closure (ClosureInfo "h$ap2_e" (CIRegs 0 [PtrV]) "apply2" (CILayoutFixed 3 [PtrV, PtrV, PtrV]) CIThunk mempty)
+               (jVar $ \d1 d2 d3 ->
+                   mconcat [ d1 |= r1 .^ "d1"
+                           , d2 |= r1 .^ "d2" .^ "d1"
+                           , d3 |= r1 .^ "d2" .^ "d2"
+                           , appS "h$bh" []
+                           , profStat s enterCostCentreThunk
+                           , r1 |= d1
+                           , r2 |= d2
+                           , r3 |= d3
+                           , returnS (app "h$ap_2_2_fast" [])
+                           ])
+          -- function application to three arguments
+          , closure (ClosureInfo "h$ap3_e" (CIRegs 0 [PtrV]) "apply3" (CILayoutFixed 4 [PtrV, PtrV, PtrV, PtrV]) CIThunk mempty)
+               (jVar $ \d1 d2 d3 d4 ->
+                   mconcat [ d1 |= r1 .^ "d1"
+                           , d2 |= r1 .^ "d2" .^ "d1"
+                           , d3 |= r1 .^ "d2" .^ "d2"
+                           , d4 |= r1 .^ "d2" .^ "d3"
+                           , appS "h$bh" []
+                           , r1 |= d1
+                           , r2 |= d2
+                           , r3 |= d3
+                           , r4 |= d4
+                           , returnS (app "h$ap_3_3_fast" [])
+                           ])
+          -- select first field
+          , closure (ClosureInfo "h$select1_e" (CIRegs 0 [PtrV]) "select1" (CILayoutFixed 1 [PtrV]) CIThunk mempty)
+               (jVar $ \t ->
+                   mconcat [ t |= r1 .^ "d1"
+                           , adjSp' 3
+                           , stack .! (sp - 2) |= r1
+                           , stack .! (sp - 1) |= var "h$upd_frame"
+                           , stack .! sp |= var "h$select1_ret"
+                           , r1 .^ "f" |= var "h$blackhole"
+                           , r1 .^ "d1" |= var "h$currentThread"
+                           , r1 .^ "d2" |= null_
+                           , r1 |= t
+                           , returnS (app "h$ap_0_0_fast" [])
+                           ])
+          , closure (ClosureInfo "h$select1_ret" (CIRegs 0 [PtrV]) "select1ret" (CILayoutFixed 0 []) CIStackFrame mempty)
+               ((r1 |= r1 .^ "d1")
+                <> adjSpN' 1
+                <> returnS (app "h$ap_0_0_fast" [])
+               )
+          -- select second field of a two-field constructor
+          , closure (ClosureInfo "h$select2_e" (CIRegs 0 [PtrV]) "select2" (CILayoutFixed 1 [PtrV]) CIThunk mempty)
+               (jVar $ \t ->
+                   mconcat [t |= r1 .^ "d1"
+                           , adjSp' 3
+                           , stack .! (sp - 2) |= r1
+                           , stack .! (sp - 1) |= var "h$upd_frame"
+                           , stack .! sp |= var "h$select2_ret"
+                           , r1 .^ "f" |= var "h$blackhole"
+                           , r1 .^ "d1" |= var "h$currentThread"
+                           , r1 .^ "d2" |= null_
+                           , r1 |= t
+                           , returnS (app "h$ap_0_0_fast" [])
+                           ]
+                  )
+          , closure (ClosureInfo "h$select2_ret" (CIRegs 0 [PtrV]) "select2ret" (CILayoutFixed 0 []) CIStackFrame mempty)
+                        $ mconcat [ r1 |= r1 .^ "d2"
+                                  , adjSpN' 1
+                                  , returnS (app "h$ap_0_0_fast" [])
+                                  ]
+          -- a thunk that just raises a synchronous exception
+          , closure (ClosureInfo "h$raise_e" (CIRegs 0 [PtrV]) "h$raise_e" (CILayoutFixed 0 []) CIThunk mempty)
+               (returnS (app "h$throw" [r1 .^ "d1", false_]))
+          , closure (ClosureInfo "h$raiseAsync_e" (CIRegs 0 [PtrV]) "h$raiseAsync_e" (CILayoutFixed 0 []) CIThunk mempty)
+               (returnS  (app "h$throw" [r1 .^ "d1", true_]))
+          , closure (ClosureInfo "h$raiseAsync_frame" (CIRegs 0 []) "h$raiseAsync_frame" (CILayoutFixed 1 []) CIStackFrame mempty)
+               (jVar $ \ex ->
+                   mconcat [ ex |= stack .! (sp - 1)
+                           , adjSpN' 2
+                           , returnS (app "h$throw" [ex, 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
+          -}
+          , closure (ClosureInfo "h$reduce" (CIRegs 0 [PtrV]) "h$reduce" (CILayoutFixed 0 []) CIStackFrame mempty)
+               (ifS (isThunk r1)
+                    (returnS (r1 .^ "f"))
+                    (adjSpN' 1 <> returnS (stack .! sp))
+               )
+          , rtsApply s
+          , closureTypes
+          , closure (ClosureInfo "h$runio_e" (CIRegs 0 [PtrV]) "runio" (CILayoutFixed 1 [PtrV]) CIThunk mempty)
+                        $ mconcat [ r1 |= r1 .^ "d1"
+                                  , stack .! PreInc sp |= var "h$ap_1_0"
+                                  , returnS (var "h$ap_1_0")
+                                  ]
+          , closure (ClosureInfo "h$flushStdout_e" (CIRegs 0 []) "flushStdout" (CILayoutFixed 0 []) CIThunk mempty)
+                        $ mconcat [ r1 |= var "h$baseZCGHCziIOziHandlezihFlush"
+                                  , r2 |= var "h$baseZCGHCziIOziHandleziFDzistdout"
+                                  , returnS (app "h$ap_1_1_fast" [])
+                                  ]
+          , TxtI "h$flushStdout" ||= app "h$static_thunk" [var "h$flushStdout_e"]
+          -- the scheduler pushes this frame when suspending a thread that
+          -- has not called h$reschedule explicitly
+          , closure (ClosureInfo "h$restoreThread" (CIRegs 0 []) "restoreThread" CILayoutVariable CIStackFrame mempty)
+                (jVar $ \f frameSize nregs ->
+                    mconcat [f |= stack .! (sp - 2)
+                            , frameSize |= stack .! (sp - 1)
+                            , nregs |= frameSize - 3
+                            , loop 1 (.<=. nregs)
+                                     (\i -> appS "h$setReg" [i, stack .! (sp - 2 - i)] <> postIncrS i)
+                            , sp |= sp - frameSize
+                            , returnS f
+                            ])
+          -- return a closure in the stack frame to the next thing on the stack
+          , closure (ClosureInfo "h$return" (CIRegs 0 []) "return" (CILayoutFixed 1 [PtrV]) CIStackFrame mempty)
+                ((r1 |= stack .! (sp - 1))
+                 <> adjSpN' 2
+                 <> returnS (stack .! sp))
+          --  return a function in the stack frame for the next call
+          , closure (ClosureInfo "h$returnf" (CIRegs 0 [PtrV]) "returnf" (CILayoutFixed 1 [ObjV]) CIStackFrame mempty)
+                (jVar $ \r ->
+                    mconcat [ r |= stack .! (sp - 1)
+                            , adjSpN' 2
+                            , returnS 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
+          , closure (ClosureInfo "h$reschedule" (CIRegs 0 []) "reschedule" (CILayoutFixed 0 []) CIThunk mempty)
+                (returnS $ var "h$reschedule")
+          -- debug thing, insert on stack to dump current result, should be boxed
+          , closure (ClosureInfo "h$dumpRes" (CIRegs 0 [PtrV]) "dumpRes" (CILayoutFixed 1 [ObjV]) CIThunk mempty)
+                (jVar $ \re ->
+                    mconcat [ appS "h$log" [jString "h$dumpRes result: " + stack .! (sp-1)]
+                            , appS "h$log" [r1]
+                            , appS "h$log" [app "h$collectProps" [r1]]
+                            , jwhenS ((r1 .^ "f") .&&. (r1 .^ "f" .^ "n"))
+                                        (appS "h$log" [jString "name: " + r1 .^ "f" .^ "n"])
+                            , jwhenS (ApplExpr (r1 .^ "hasOwnProperty") [jString "d1"])
+                                        (appS "h$log" [jString "d1: " + r1 .^ "d1"])
+                            , jwhenS (ApplExpr (r1 .^ "hasOwnProperty") [jString "d2"])
+                                        (appS "h$log" [jString "d2: " + r1 .^ "d2"])
+                            , jwhenS (r1 .^ "f") $ mconcat
+                                [ re |= New (app "RegExp" [jString "([^\\n]+)\\n(.|\\n)*"])
+                                , appS "h$log" [jString "function"
+                                                + ApplExpr (ApplExpr ((jString "" + r1 .^ "f") .^ "substring") [0, 50] .^ "replace") [r1, jString "$1"]]
+                                ]
+                            , adjSpN' 2
+                            , r1 |= null_
+                            , returnS (stack .! sp)
+                            ])
+          , closure (ClosureInfo "h$resume_e" (CIRegs 0 [PtrV]) "resume" (CILayoutFixed 0 []) CIThunk mempty)
+                  (jVar $ \ss ->
+                      mconcat [ss |= r1 .^ "d1"
+                              , updateThunk' s
+                              , loop 0 (.<. ss .^ "length") (\i -> (stack .! (sp+1+i) |= ss .! i)
+                                                                   <> postIncrS i)
+                              , sp |= sp + ss .^ "length"
+                              , r1 |= null_
+                              , returnS (stack .! sp)
+                              ])
+          , closure (ClosureInfo "h$unmaskFrame" (CIRegs 0 [PtrV]) "unmask" (CILayoutFixed 0 []) CIStackFrame mempty)
+               ((var "h$currentThread" .^ "mask" |= 0)
+                <> adjSpN' 1
+                -- back to scheduler to give us async exception if pending
+                <> ifS (var "h$currentThread" .^ "excep" .^ "length" .>. 0)
+                    (push' s [r1, var "h$return"] <> returnS (var "h$reschedule"))
+                    (returnS (stack .! sp)))
+          , closure (ClosureInfo "h$maskFrame" (CIRegs 0 [PtrV]) "mask" (CILayoutFixed 0 []) CIStackFrame mempty)
+                ((var "h$currentThread" .^ "mask" |= 2)
+                 <> adjSpN' 1
+                 <> returnS (stack .! sp))
+          , closure (ClosureInfo "h$maskUnintFrame" (CIRegs 0 [PtrV]) "maskUnint" (CILayoutFixed 0 []) CIStackFrame mempty)
+                ((var "h$currentThread" .^ "mask" |= 1)
+                 <> adjSpN' 1
+                 <> returnS (stack .! sp))
+          , closure (ClosureInfo "h$unboxFFIResult" (CIRegs 0 [PtrV]) "unboxFFI" (CILayoutFixed 0 []) CIStackFrame mempty)
+               (jVar $ \d ->
+                   mconcat [d |= r1 .^ "d1"
+                           , loop 0 (.<. d .^ "length") (\i -> appS "h$setReg" [i + 1, d .! i] <> postIncrS i)
+                           , adjSpN' 1
+                           , returnS (stack .! sp)
+                           ])
+          , closure (ClosureInfo "h$unbox_e" (CIRegs 0 [PtrV]) "unboxed value" (CILayoutFixed 1 [DoubleV]) CIThunk mempty)
+               ((r1 |= r1 .^ "d1") <> returnS (stack .! sp))
+          , closure (ClosureInfo "h$retryInterrupted" (CIRegs 0 [ObjV]) "retry interrupted operation" (CILayoutFixed 1 [ObjV]) CIStackFrame mempty)
+               (jVar $ \a ->
+                   mconcat [ a |= stack .! (sp - 1)
+                           , adjSpN' 2
+                           , returnS (ApplExpr (a .! 0 .^ "apply") [var "this", ApplExpr (a .^ "slice") [1]])
+                           ])
+          , closure (ClosureInfo "h$atomically_e" (CIRegs 0 [PtrV]) "atomic operation" (CILayoutFixed 1 [PtrV]) CIStackFrame mempty)
+               (ifS (app "h$stmValidateTransaction" [])
+                    (appS "h$stmCommitTransaction" []
+                     <> adjSpN' 2
+                     <> returnS (stack .! sp))
+                    (push' s [var "h$checkInvariants_e"]
+                     <> returnS (app "h$stmStartTransaction" [stack .! (sp - 2)])))
+          , closure (ClosureInfo "h$checkInvariants_e" (CIRegs 0 [PtrV]) "check transaction invariants" (CILayoutFixed 0 []) CIStackFrame mempty)
+               (adjSpN' 1
+                <> returnS (app "h$stmCheckInvariants" []))
+          , closure (ClosureInfo "h$stmCheckInvariantStart_e" (CIRegs 0 []) "start checking invariant" (CILayoutFixed 2 [ObjV, RtsObjV]) CIStackFrame mempty)
+                        (jVar $ \t inv m t1 ->
+                            mconcat [ t   |= stack .! (sp - 2)
+                                    , inv |= stack .! (sp - 1)
+                                    , m   |= var "h$currentThread" .^ "mask"
+                                    , adjSpN' 3
+                                    , t1  |= UOpExpr NewOp (app "h$Transaction" [inv .^ "action", t])
+                                    , t1 .^ "checkRead" |= UOpExpr NewOp (app "h$Set" [])
+                                    , var "h$currentTread" .^ "transaction" |= t1
+                                    , push' s [t1, m, var "h$stmInvariantViolatedHandler", var "h$catchStm_e"]
+                                    , r1  |= inv .^ "action"
+                                    , returnS (app "h$ap_1_0_fast" [])
+                                    ])
+          , closure (ClosureInfo "h$stmCheckInvariantResult_e" (CIRegs 0 [PtrV]) "finish checking invariant" (CILayoutFixed 1 [ObjV]) CIStackFrame mempty)
+                        (jVar $ \inv ->
+                            mconcat [ inv |= stack .! (sp -1)
+                                    , adjSpN' 2
+                                    , appS "h$stmUpdateInvariantDependencies" [inv]
+                                    , appS "h$stmAbortTransaction" []
+                                    , returnS (stack .! sp)
+                                    ])
+
+          -- update invariant TVar dependencies and rethrow exception
+          -- handler must be pushed above h$stmCheckInvariantResult_e frame
+          , closure (ClosureInfo "h$stmInvariantViolatedHandler_e" (CIRegs 0 [PtrV]) "finish checking invariant" (CILayoutFixed 0 []) (CIFun 2 1) mempty)
+                        (jVar $ \inv ->
+                            mconcat [ jwhenS (stack .! sp .===. var "h$stmCheckInvariantResult_e")
+                                                (appS "throw" [jString "h$stmInvariantViolatedHandler_e: unexpected value on stack"])
+                                    , inv |= stack .! (sp - 2)
+                                    , adjSpN' 2
+                                    , appS "h$stmUpdateInvariantDependencies" []
+                                    , appS "h$stmAbortTransaction" []
+                                    , returnS (app "h$throw" [r2, false_])
+                                    ])
+          , TxtI "h$stmInvariantViolatedHandler" ||= app "h$c" (var "h$stmInvariantViolatedHandler_e" : [jSystemCCS | csProf s])
+          , closure (ClosureInfo "h$stmCatchRetry_e" (CIRegs 0 [PtrV]) "catch retry" (CILayoutFixed 1 [PtrV]) CIStackFrame mempty)
+                        (adjSpN' 2
+                         <> appS "h$stmCommitTransaction" []
+                         <> returnS (stack .! sp))
+          , closure (ClosureInfo "h$catchStm_e" (CIRegs 0 [PtrV]) "STM catch" (CILayoutFixed 3 [ObjV,PtrV,ObjV]) CIStackFrame mempty)
+                       (adjSpN' 4 <> returnS (stack .! sp))
+          , closure (ClosureInfo "h$stmResumeRetry_e" (CIRegs 0 [PtrV]) "resume retry" (CILayoutFixed 0 []) CIStackFrame mempty)
+                        (jVar $ \blocked ->
+                            mconcat [ jwhenS (stack .! (sp - 2) .!==. var "h$atomically_e")
+                                                 (appS "throw" [jString "h$stmResumeRetry_e: unexpected value on stack"])
+                                    , blocked |= stack .! (sp - 1)
+                                    , adjSpN' 2
+                                    , push' s [var "h$checkInvariants_e"]
+                                    , appS "h$stmRemoveBlockedThread" [blocked, var "h$currentThread"]
+                                    , returnS (app "h$stmStartTransaction" [stack .! (sp - 2)])
+                                    ])
+          , closure (ClosureInfo "h$lazy_e" (CIRegs 0 [PtrV]) "generic lazy value" (CILayoutFixed 0 []) CIThunk mempty)
+                        (jVar $ \x ->
+                            mconcat [x |= ApplExpr (r1 .^ "d1") []
+                                    , appS "h$bh" []
+                                    , profStat s enterCostCentreThunk
+                                    , r1 |= x
+                                    , returnS (stack .! sp)
+                                    ])
+          -- Top-level statements to generate only in profiling mode
+          , profStat s (closure (ClosureInfo "h$setCcs_e" (CIRegs 0 [PtrV]) "set cost centre stack" (CILayoutFixed 1 [ObjV]) CIStackFrame mempty)
+                        (appS "h$restoreCCS" [ stack .! (sp - 1)]
+                         <> adjSpN' 2
+                         <> returnS (stack .! sp)))
+          ]
diff --git a/compiler/GHC/JS/Rts/Types.hs b/compiler/GHC/JS/Rts/Types.hs
new file mode 100644
index 0000000000..68c42b0ea9
--- /dev/null
+++ b/compiler/GHC/JS/Rts/Types.hs
@@ -0,0 +1,104 @@
+{-# LANGUAGE CPP,
+             FlexibleInstances,
+             OverloadedStrings #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.JS.Rts.Apply
+-- 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>
+-- Stability   :  experimental
+--
+-- Types and utility functions used in the JS RTS.
+-- FIXME: Jeff (2022,03): Add more details
+-----------------------------------------------------------------------------
+
+module GHC.JS.Rts.Types where
+
+import           GHC.JS.Make
+import           GHC.JS.Syntax
+import           GHC.StgToJS.Regs
+import           GHC.StgToJS.Types
+
+import           GHC.Utils.Monad.State.Strict
+import qualified GHC.Data.ShortText as T
+
+import GHC.Prelude
+
+
+traceRts :: StgToJSConfig -> JExpr -> JStat
+traceRts s ex = jStatIf (csTraceRts s) (appS "h$log" [ex])
+
+assertRts :: ToJExpr a => StgToJSConfig -> JExpr -> a -> JStat
+assertRts s ex m = jStatIf (csAssertRts s)
+  (jwhenS (UOpExpr NotOp ex) (appS "throw" [toJExpr m]))
+
+jStatIf :: Bool -> JStat -> JStat
+jStatIf True s = s
+jStatIf _    _ = mempty
+
+clName :: JExpr -> JExpr
+clName c = c .^ "n"
+
+clTypeName :: JExpr -> JExpr
+clTypeName c = app "h$closureTypeName" [c .^ "t"]
+
+type C = State GenState JStat
+
+assertRtsStat :: C -> C
+assertRtsStat stat = do
+  s <- gets gsSettings
+  if csAssertRts s then stat else return mempty
+
+-- number of  arguments (arity & 0xff = arguments, arity >> 8 = number of registers)
+stackFrameSize :: JExpr -- ^ assign frame size to this
+               -> JExpr -- ^ stack frame header function
+               -> JStat -- ^ size of the frame, including header
+stackFrameSize tgt f =
+  ifS (f .===. var "h$ap_gen") -- h$ap_gen is special
+      (tgt |= (stack .! (sp - 1) .>>. 8) + 2)  -- special case, FIXME (Jeff, 2022/03): what and why is
+                                               -- it special and how does its
+                                               -- special-ness change this code
+      (jVar (\tag ->
+               mconcat
+               [tag |= f .^ "size"
+               , ifS (tag .<. 0)              -- if tag is less than 0
+                 (tgt |= stack .! (sp - 1))   -- set target to stack pointer - 1
+                 (tgt |= mask8 tag + 1)       -- else set to mask'd tag + 1
+               ]
+        ))
+
+-- some utilities do do something with a range of regs
+-- start or end possibly supplied as javascript expr
+withRegs :: StgReg -> StgReg -> (StgReg -> JStat) -> JStat
+withRegs start end f = mconcat $ map f [start..end]
+
+withRegs' :: StgReg -> StgReg -> (StgReg -> JStat) -> JStat
+withRegs' start end = withRegs start end
+
+-- start from js expr, start is guaranteed to be at least min
+-- from low to high (fallthrough!)
+withRegsS :: JExpr -> StgReg -> StgReg -> Bool -> (StgReg -> JStat) -> JStat
+withRegsS start min end fallthrough f =
+  SwitchStat start (map mkCase [min..end]) mempty
+    where
+      brk | fallthrough = mempty
+          | otherwise   = BreakStat Nothing
+      mkCase r = let stat = f r
+                  in (toJExpr r, mconcat [stat , stat , brk])
+
+-- end from js expr, from high to low
+withRegsRE :: StgReg -> JExpr -> StgReg -> Bool -> (StgReg -> JStat) -> JStat
+withRegsRE start end max fallthrough f =
+  SwitchStat end (reverse $ map mkCase [start..max]) mempty
+    where
+      brk | fallthrough = mempty
+          | otherwise   = BreakStat Nothing
+      mkCase r = (toJExpr (fromEnum r), mconcat [f r , brk])
+
+jsVar :: String -> JExpr
+jsVar = ValExpr . JVar . TxtI . T.pack
diff --git a/compiler/GHC/JS/Syntax.hs b/compiler/GHC/JS/Syntax.hs
index 79f53f39ee..ec7e1feb35 100644
--- a/compiler/GHC/JS/Syntax.hs
+++ b/compiler/GHC/JS/Syntax.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -9,7 +8,6 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE PatternSynonyms #-}
@@ -70,6 +68,12 @@ import qualified GHC.Data.ShortText as ST
 import GHC.Data.ShortText (ShortText)
 import GHC.Utils.Monad.State.Strict
 
+-- FIXME: Jeff (2022,03): This state monad is strict, but uses a lazy list as
+-- the state, since the strict state monad evaluates to WHNF, this state monad
+-- will only evaluate to the first cons cell, i.e., we will be spine strict but
+-- store possible huge thunks. This isn't a problem as long as we use this list
+-- as a stack, but if we don't then any kind of Functor or Traverse operation
+-- over this state will become yield a lot of thunks.
 newtype IdentSupply a
   = IS {runIdentSupply :: State [Ident] a}
   deriving Typeable
@@ -100,7 +104,11 @@ instance Show a => Show (IdentSupply a) where
     show x = "(" ++ show (pseudoSaturate x) ++ ")"
 
 
--- | Statements
+--------------------------------------------------------------------------------
+--                            Statements
+--------------------------------------------------------------------------------
+-- FIXME (Jeff, 2022/03): statements according to what version of the standard?
+-- | JavaScript statements
 data JStat
   = DeclStat   Ident
   | ReturnStat JExpr
@@ -141,7 +149,13 @@ appendJStat mx my = case (mx,my) of
 
 
 
--- TODO: annotate expressions with type
+--------------------------------------------------------------------------------
+--                            Expressions
+--------------------------------------------------------------------------------
+-- FIXME (Jeff, 2022/03): Expressions according to what version of the standard?
+-- FIXME: annotate expressions with type. This is an EDSL of JS ASTs in Haskell.
+-- There are many approaches to leveraging the GHCs type system for correctness
+-- guarentees in EDSLs and we should use them
 -- | Expressions
 data JExpr
   = ValExpr    JVal
@@ -213,6 +227,9 @@ pattern Int x = ValExpr (JInt x)
 pattern String :: ShortText -> JExpr
 pattern String x = ValExpr (JStr x)
 
+--------------------------------------------------------------------------------
+--                            Values
+--------------------------------------------------------------------------------
 -- | Values
 data JVal
   = JVar     Ident
@@ -231,6 +248,9 @@ instance Outputable JVal where
 
 instance NFData JVal
 
+--------------------------------------------------------------------------------
+--                            Operators
+--------------------------------------------------------------------------------
 data JOp
   = EqOp            -- ==
   | StrictEqOp      -- ===
@@ -294,6 +314,12 @@ instance Ord SaneDouble where
 instance Show SaneDouble where
     show (SaneDouble x) = show x
 
+--------------------------------------------------------------------------------
+--                            Identifiers
+--------------------------------------------------------------------------------
+-- We use ShortText for identifier in JS backend
+
 -- | Identifiers
 newtype Ident = TxtI { itxt:: ShortText}
  deriving (Show, Typeable, Ord, Eq, Generic, NFData)
+
diff --git a/compiler/GHC/StgToJS/CoreUtils.hs b/compiler/GHC/StgToJS/CoreUtils.hs
index b945024c1b..e039483a12 100644
--- a/compiler/GHC/StgToJS/CoreUtils.hs
+++ b/compiler/GHC/StgToJS/CoreUtils.hs
@@ -1,11 +1,23 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings    #-}
+
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+-- only for ToStat ClosureInfo
+
+-- FIXME: Jeff (2022,03): fix this orphan instance. the problem is that the
+-- toStat ClosureInfo requires the helper function @closureInfoStat@ which in
+-- turn requires numerous helper functions that are in this file. Thus, if we
+-- moved this instance to StgToJS.Types then we'll create a module import cycle.
+
 
 -- | Core utils
 module GHC.StgToJS.CoreUtils where
 
 import GHC.Prelude
 
+import GHC.JS.Make
 import GHC.JS.Syntax
+
 import GHC.StgToJS.Types
 
 import GHC.Stg.Syntax
@@ -28,6 +40,9 @@ import GHC.Utils.Misc
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
 
+import qualified Data.Bits as Bits
+import GHC.Data.ShortText
+
 -- | can we unbox C x to x, only if x is represented as a Number
 isUnboxableCon :: DataCon -> Bool
 isUnboxableCon dc
@@ -246,5 +261,83 @@ alignPrimReps (r:rs) vs = case (primRepSize r,vs) of
 alignIdPrimReps :: Outputable a => Id -> [a] -> [(PrimRep, [a])]
 alignIdPrimReps i = alignPrimReps (idPrimReps i)
 
+
 alignIdExprs :: Id -> [JExpr] -> [TypedExpr]
 alignIdExprs i es = fmap (uncurry TypedExpr) (alignIdPrimReps i es)
+
+closureInfoStat :: Bool -> ClosureInfo -> JStat
+closureInfoStat debug (ClosureInfo obj rs name layout CIThunk srefs) =
+    setObjInfoL debug obj rs layout Thunk name 0 srefs
+closureInfoStat debug (ClosureInfo obj rs name layout (CIFun arity nregs) srefs) =
+    setObjInfoL debug obj rs layout Fun name (mkArityTag arity nregs) srefs
+closureInfoStat debug (ClosureInfo obj rs name layout (CICon con) srefs) =
+    setObjInfoL debug obj rs layout Con name con srefs
+closureInfoStat debug (ClosureInfo obj rs name layout CIBlackhole srefs)   =
+    setObjInfoL debug obj rs layout Blackhole name 0 srefs
+closureInfoStat debug (ClosureInfo obj rs name layout CIPap srefs)  =
+    setObjInfoL debug obj rs layout Pap name 0 srefs
+closureInfoStat debug (ClosureInfo obj rs name layout CIStackFrame srefs) =
+    setObjInfoL debug obj rs layout StackFrame name 0 srefs
+
+setObjInfoL :: Bool        -- ^ debug: output symbol names
+            -> ShortText   -- ^ the object name
+            -> CIRegs      -- ^ things in registers
+            -> CILayout    -- ^ layout of the object
+            -> ClosureType -- ^ closure type
+            -> ShortText   -- ^ object name, for printing
+            -> Int         -- ^ `a' argument, depends on type (arity, conid)
+            -> CIStatic    -- ^ static refs
+            -> JStat
+setObjInfoL debug obj rs CILayoutVariable t n a =
+  setObjInfo debug obj t n [] a (-1) rs
+setObjInfoL debug obj rs (CILayoutUnknown size) t n a =
+  setObjInfo debug obj t n xs a size rs
+    where
+      xs  = toTypeList (replicate size ObjV)
+setObjInfoL debug obj rs (CILayoutFixed size layout) t n a =
+  setObjInfo debug obj t n xs a size rs
+    where
+      xs   = toTypeList layout
+
+setObjInfo :: Bool        -- ^ debug: output all symbol names
+           -> ShortText   -- ^ the thing to modify
+           -> ClosureType -- ^ closure type
+           -> ShortText   -- ^ object name, for printing
+           -> [Int]       -- ^ list of item types in the object, if known (free variables, datacon fields)
+           -> Int         -- ^ extra 'a' parameter, for constructor tag or arity
+           -> Int         -- ^ object size, -1 (number of vars) for unknown
+           -> CIRegs      -- ^ things in registers [VarType]  -- ^ things in registers
+           -> CIStatic    -- ^ static refs
+           -> JStat
+setObjInfo debug obj t name fields a size regs static
+   | debug     = appS "h$setObjInfo" [ var obj
+                                     , toJExpr t
+                                     , toJExpr name
+                                     , toJExpr fields
+                                     , toJExpr a
+                                     , toJExpr size
+                                     , toJExpr (regTag regs)
+                                     , toJExpr static
+                                     ] -- error "setObjInfo1" -- [j| h$setObjInfo(`TxtI obj`, `t`, `name`, `fields`, `a`, `size`, `regTag regs`, `static`); |]
+   | otherwise = appS "h$o" [ var obj
+                            , toJExpr t
+                            , toJExpr a
+                            , toJExpr size
+                            , toJExpr (regTag regs)
+                            , toJExpr static
+                            ] -- error "setObjInfo2" -- [j| h$o(`TxtI obj`,`t`,`a`,`size`,`regTag regs`,`static`); |]
+  where
+    regTag CIRegsUnknown       = -1
+    regTag (CIRegs skip types) =
+      let nregs = sum $ map varSize types
+      in  skip + (nregs `Bits.shiftL` 8)
+
+-- | note: the statements only work after all top-level objects have been created
+instance ToStat ClosureInfo where
+  toStat = closureInfoStat False
+
+mkArityTag :: Int -> Int -> Int
+mkArityTag arity registers = arity Bits..|. (registers `Bits.shiftL` 8)
+
+toTypeList :: [VarType] -> [Int]
+toTypeList = concatMap (\x -> replicate (varSize x) (fromEnum x))
diff --git a/compiler/GHC/StgToJS/DataCon.hs b/compiler/GHC/StgToJS/DataCon.hs
index 01e15bbfae..e68b22605b 100644
--- a/compiler/GHC/StgToJS/DataCon.hs
+++ b/compiler/GHC/StgToJS/DataCon.hs
@@ -6,6 +6,7 @@ module GHC.StgToJS.DataCon
   , allocCon
   , allocUnboxedCon
   , allocDynamicE
+  , allocDynamic
   )
 where
 
diff --git a/compiler/GHC/StgToJS/Expr.hs b/compiler/GHC/StgToJS/Expr.hs
index 28e2706734..7fa30866f7 100644
--- a/compiler/GHC/StgToJS/Expr.hs
+++ b/compiler/GHC/StgToJS/Expr.hs
@@ -68,6 +68,7 @@ import qualified Data.List as L
 import qualified Data.Set as S
 import qualified Data.Map as M
 import Control.Monad
+import Control.Arrow ((&&&))
 
 genExpr :: HasDebugCallStack => ExprCtx -> CgStgExpr -> G (JStat, ExprResult)
 genExpr ctx stg = case stg of
@@ -169,7 +170,7 @@ genBindLne :: HasDebugCallStack
 genBindLne ctx bndr = do
   vis  <- map (\(x,y,_) -> (x,y)) <$>
             optimizeFree oldFrameSize (newLvs++map fst updBinds)
-  declUpds <- mconcat <$> mapM (fmap (\x -> x ||= null_) . jsIdI . fst) updBinds
+  declUpds <- mconcat <$> mapM (fmap (||= null_) . jsIdI . fst) updBinds
   let newFrameSize = oldFrameSize + length vis
       ctx' = ctx
         { ctxLne        = addListToUniqSet (ctxLne ctx) bound
@@ -181,8 +182,8 @@ genBindLne ctx bndr = do
   where
     oldFrame     = ctxLneFrame ctx
     oldFrameSize = length oldFrame
-    isOldLv i    = i `elementOfUniqSet` (ctxLne ctx) ||
-                   i `elem` (map fst oldFrame)
+    isOldLv i    = i `elementOfUniqSet` ctxLne ctx ||
+                   i `elem` map fst oldFrame
     live         = liveVars $ mkDVarSet $ stgLneLive' bndr
     newLvs       = filter (not . isOldLv) (dVarSetElems live)
     binds = case bndr of
@@ -210,7 +211,7 @@ genEntryLne ctx i rhs@(StgRhsClosure _ext _cc update args body) =
       myOffset    =
         maybe (panic "genEntryLne: updatable binder not found in let-no-escape frame")
               ((payloadSize-) . fst)
-              (listToMaybe $ filter ((==i).fst.snd) (zip [0..] frame))
+              (L.find ((==i) . fst . snd) (zip [0..] frame))
       bh | isUpdatable update =
              jVar (\x -> mconcat
               [ x |= ApplExpr (var "h$bh_lne") [Sub sp (toJExpr myOffset), toJExpr (payloadSize+1)]
@@ -244,7 +245,7 @@ genEntryLne ctx i (StgRhsCon cc con _mu _ticks args) = resetSlots $ do
 
 -- generate the entry function for a local closure
 genEntry :: HasDebugCallStack => ExprCtx -> Id -> CgStgRhs -> G ()
-genEntry _ _i (StgRhsCon {}) = return () -- mempty -- error "local data entry"
+genEntry _ _i StgRhsCon {} = return () -- mempty -- error "local data entry"
 genEntry ctx i rhs@(StgRhsClosure _ext cc {-_bi live-} upd_flag args body) = resetSlots $ do
   let live = stgLneLiveExpr rhs -- error "fixme" -- probably find live vars in body
   ll    <- loadLiveFun live
@@ -544,7 +545,7 @@ genRet ctx e at as l = withNewIdent f
     lneLive    = maximum $ 0 : map (fromMaybe 0 . lookupUFM (ctxLneFrameBs ctx)) allRefs
     ctx'       = adjustCtxStack lneLive ctx
     lneVars    = map fst $ take lneLive (ctxLneFrame ctx)
-    isLne i    = i `elem` lneVars || i `elementOfUniqSet` (ctxLne ctx)
+    isLne i    = i `elem` lneVars || i `elementOfUniqSet` ctxLne ctx
     nonLne     = filter (not . isLne) (dVarSetElems l)
 
     f :: Ident -> G JStat
@@ -562,8 +563,7 @@ genRet ctx e at as l = withNewIdent f
                     ri
                     (fixedLayout . reverse $
                        map (stackSlotType . fst3) free
-                       ++ if prof then [ObjV] else []
-                       ++ map stackSlotType lneVars)
+                       ++ if prof then [ObjV] else map stackSlotType lneVars)
                     CIStackFrame
                     sr
       emitToplevel $ r ||= toJExpr (JFunc [] fun')
@@ -600,7 +600,7 @@ genAlts ctx e at me alts = do
   (st, er) <- case at of
 
     PolyAlt -> case alts of
-      [alt] -> (\b -> (branch_stat b, branch_result b)) <$> mkAlgBranch ctx e alt
+      [alt] -> (branch_stat &&& branch_result) <$> mkAlgBranch ctx e alt
       _     -> panic "genAlts: multiple polyalt"
 
     PrimAlt _tc
@@ -885,24 +885,28 @@ allocDynAll haveDecl middle cls = do
     middle' = fromMaybe mempty middle
 
     makeObjs :: G JStat
-    makeObjs = do
+    makeObjs =
       fmap mconcat $ forM cls $ \(i,f,_,cc) -> do
-        ccs <- maybeToList <$> costCentreStackLbl cc
-        pure $ mconcat
-          [ dec i
-          , toJExpr i |= if csInlineAlloc settings
-              then ValExpr (jhFromList $ [ (closureEntry_ , f)
-                                         , (closureExtra1_, null_)
-                                         , (closureExtra2_, null_)
-                                         , (closureMeta_  , zero_)
-                                         ]
-                               ++ fmap (\cid -> ("cc", ValExpr (JVar cid))) ccs)
-              else ApplExpr (var "h$c") (f : fmap (\cid -> ValExpr (JVar cid)) ccs)
-          ]
+      ccs <- maybeToList <$> costCentreStackLbl cc
+      pure $ mconcat
+        [ dec i
+        , toJExpr i |= if csInlineAlloc settings
+            then ValExpr (jhFromList $ [ (closureEntry_ , f)
+                                       , (closureExtra1_, null_)
+                                       , (closureExtra2_, null_)
+                                       , (closureMeta_  , zero_)
+                                       ]
+                             ++ fmap (\cid -> ("cc", ValExpr (JVar cid))) ccs)
+            else ApplExpr (var "h$c") (f : fmap (ValExpr . JVar) ccs)
+        ]
 
     fillObjs = mconcat $ map fillObj cls
     fillObj (i,_,es,_)
-      | csInlineAlloc settings || length es > 24 =
+      | csInlineAlloc settings || length es > 24 = -- FIXME (Jeff, 2022/03): the call to length means `es`
+                                                   -- should be something other than
+                                                   -- a list. Also why is 24
+                                                   -- important? And 24 should be a
+                                                   -- constant such as `fooThreshold`
           case es of
             []      -> mempty
             [ex]    -> toJExpr i .^ closureExtra1_ |= toJExpr ex
@@ -931,7 +935,8 @@ allocDynAll haveDecl middle cls = do
 
     dec i | haveDecl  = DeclStat i
           | otherwise = mempty
-    checkObjs | csAssertRts settings  = mconcat $ map (\(i,_,_,_) -> (ApplStat (ValExpr (JVar (TxtI "h$checkObj")))) (((:) (toJExpr i)) []){-[j| h$checkObj(`i`); |]-}) cls
+    checkObjs | csAssertRts settings  = mconcat $
+                map (\(i,_,_,_) -> ApplStat (ValExpr (JVar (TxtI "h$checkObj"))) [toJExpr i] {-[j| h$checkObj(`i`); |]-}) cls
               | otherwise = mempty
 
   objs <- makeObjs
diff --git a/compiler/GHC/StgToJS/Heap.hs b/compiler/GHC/StgToJS/Heap.hs
index 0edfe6729e..95d43994b9 100644
--- a/compiler/GHC/StgToJS/Heap.hs
+++ b/compiler/GHC/StgToJS/Heap.hs
@@ -26,6 +26,8 @@ module GHC.StgToJS.Heap
   , closureMeta_
   , closureExtra1_
   , closureExtra2_
+  -- * Javascript Type literals
+  , jTyObject
   )
 where
 
@@ -36,6 +38,87 @@ import GHC.JS.Make
 import GHC.StgToJS.Types
 import GHC.Data.ShortText (ShortText)
 
+-- Note [JS heap objects]
+-- ~~~~~~~~~~~~~~~~~~~~~~
+--
+-- TODO: add more details from https://www.haskell.org/haskell-symposium/2013/ghcjs.pdf
+--
+-- Objects on the heap ("closures") are represented as JavaScript objects with
+-- the following fields:
+--
+--  { f: function -- entry function
+--  , m: meta     -- meta data
+--  , d1: x       -- closure specific fields
+--  , d2: y
+--  }
+--
+-- The object returned when entering heap objects (closure.f) has the following
+-- fields:
+--
+--  { t: closure type
+--  , a: constructor tag / fun arity
+--  }
+--
+-- THUNK =
+--  { f  = returns the object reduced to WHNF
+--  , m  = ?
+--  , d1 = ?
+--  , d2 = ?
+--  }
+--
+-- FUN =
+--  { f  = function itself
+--  , m  = ?
+--  , d1 = free variable 1
+--  , d2 = free variable 2
+--  }
+--
+-- PAP =
+--  { f  = ?
+--  , m  = ?
+--  , d1 = ?
+--  , d2 =
+--    { d1 = PAP arity
+--    }
+--  }
+--
+-- CON =
+--  { f  = entry function of the datacon worker
+--  , m  = 0
+--  , d1 = first arg
+--  , d2 = arity = 2: second arg
+--         arity > 2: { d1, d2, ...} object with remaining args (starts with "d1 = x2"!)
+--  }
+--
+-- BLACKHOLE =
+--  { f  = h$blackhole
+--  , m  = ?
+--  , d1 = owning TSO
+--  , d2 = waiters array
+--  }
+--
+-- STACKFRAME =
+--  { f  = ?
+--  , m  = ?
+--  , d1 = ?
+--  , d2 = ?
+--  }
+
+-- FIXME: Jeff (2022,03): These helpers are a classic case of using a newtype
+-- over a type synonym to leverage GHC's type checker. Basically we never want
+-- to mix these up, and so we should have:
+--------------------------------------
+-- newtype ClosureEntry  = ClosureEntry  { unClosureEntry  :: ShortText }
+-- newtype ClosureExtra1 = ClosureExtra1 { unClosureExtra1 :: ShortText }
+-- newtype ClosureExtra2 = ClosureExtra2 { unClosureExtra2 :: ShortText }
+-- newtype ClosureMeta   = ClosureMeta   { unClosureMeta   :: ShortText }
+--------------------------------------
+-- especially since any bugs which result from confusing these will be catastrophic and hard to debug
+-- also NOTE: if ClosureExtra<N> is truly unbounded then we should have:
+-- newtype ClosureExtras = ClosureExtras { unClosureExtras :: [ShortText] }
+-- or use an Array and amortize increasing the arrays size when needed; depending
+-- on its use case in the RTS of course
+
 closureEntry_ :: ShortText
 closureEntry_ = "f"
 
@@ -57,7 +140,8 @@ entryConTag_ = "a"
 entryFunArity_ :: ShortText
 entryFunArity_ = "a"
 
-
+jTyObject :: JExpr
+jTyObject = jString "object"
 
 closureType :: JExpr -> JExpr
 closureType = entryClosureType . entry
diff --git a/compiler/GHC/StgToJS/Monad.hs b/compiler/GHC/StgToJS/Monad.hs
index 275aab9dab..982a1846c1 100644
--- a/compiler/GHC/StgToJS/Monad.hs
+++ b/compiler/GHC/StgToJS/Monad.hs
@@ -14,6 +14,7 @@ module GHC.StgToJS.Monad
   , updateThunk
   , updateThunk'
   , liftToGlobal
+  , bhStats
   -- * IDs
   , withNewIdent
   , makeIdent
@@ -23,6 +24,7 @@ module GHC.StgToJS.Monad
   , jsIdN
   , jsIdI
   , jsIdIN
+  , jsIdIdent'
   , jsIdV
   , jsEnId
   , jsEnIdI
@@ -55,6 +57,7 @@ module GHC.StgToJS.Monad
   , push'
   , adjSpN
   , adjSpN'
+  , adjSp'
   , adjSp
   , pushNN
   , pushNN'
@@ -219,6 +222,25 @@ jsIdIN i n = jsIdIdent i (Just n) IdPlain
 jsIdN :: Id -> Int -> G JExpr
 jsIdN i n = ValExpr . JVar <$> jsIdIdent i (Just n) IdPlain
 
+-- uncached
+jsIdIdent' :: Id -> Maybe Int -> IdType -> G Ident
+jsIdIdent' i mn suffix0 = do
+  (prefix, u) <- mkPrefixU
+  let i' = (\x -> ST.pack $ "h$"++prefix++x++mns++suffix++u) . zEncodeString $ name
+  i' `seq` return (TxtI i')
+    where
+      suffix = idTypeSuffix suffix0
+      mns = maybe "" (('_':).show) mn
+      name = ('.':) . nameStableString . localiseName . getName $ i
+
+      mkPrefixU :: G (String, String)
+      mkPrefixU
+        | isExportedId i, Just x <- (nameModule_maybe . getName) i = do
+           let xstr = unitModuleString x
+           return (zEncodeString xstr, "")
+        | otherwise = (,('_':) . encodeUnique . getKey . getUnique $ i) . ('$':)
+                    . zEncodeString . unitModuleString <$> State.gets gsModule
+
 -- entry id
 jsEnId :: Id -> G JExpr
 jsEnId i = ValExpr . JVar <$> jsEnIdI i
diff --git a/compiler/GHC/StgToJS/Prim.hs b/compiler/GHC/StgToJS/Prim.hs
index 8e958e59ae..9a7c210888 100644
--- a/compiler/GHC/StgToJS/Prim.hs
+++ b/compiler/GHC/StgToJS/Prim.hs
@@ -961,7 +961,10 @@ fetchOpByteArray op tgt src i v = mconcat
   , i3_ src i |= op tgt v
   ]
 
--- lifted arrays
+--------------------------------------------------------------------------------
+--                            Lifted Arrays
+--------------------------------------------------------------------------------
+-- | lifted arrays
 cloneArray :: JExpr -> JExpr -> Maybe JExpr -> JExpr -> JStat
 cloneArray tgt src mb_offset len = mconcat
   [ tgt |= ApplExpr (src .^ "slice") [start, end]
@@ -980,30 +983,6 @@ newByteArray :: JExpr -> JExpr -> JStat
 newByteArray tgt len =
   tgt |= app "h$newByteArray" [len]
 
-math :: JExpr
-math = var "Math"
-
-math_ :: ShortText -> [JExpr] -> JExpr
-math_ op args = ApplExpr (math .^ op) args
-
-math_log, math_sin, math_cos, math_tan, math_exp, math_acos, math_asin, math_atan,
-  math_abs, math_pow, math_sqrt, math_asinh, math_acosh, math_atanh
-  :: [JExpr] -> JExpr
-math_log   = math_ "log"
-math_sin   = math_ "sin"
-math_cos   = math_ "cos"
-math_tan   = math_ "tan"
-math_exp   = math_ "exp"
-math_acos  = math_ "acos"
-math_asin  = math_ "asin"
-math_atan  = math_ "atan"
-math_abs   = math_ "abs"
-math_pow   = math_ "pow"
---math_sign  = math_ "sign"
-math_sqrt  = math_ "sqrt"
-math_asinh = math_ "asinh"
-math_acosh = math_ "acosh"
-math_atanh = math_ "atanh"
 
 -- e|0  (32 bit signed integer truncation)
 trunc :: JExpr -> JExpr
diff --git a/compiler/GHC/StgToJS/Profiling.hs b/compiler/GHC/StgToJS/Profiling.hs
index aac8e66ca4..8042fc562b 100644
--- a/compiler/GHC/StgToJS/Profiling.hs
+++ b/compiler/GHC/StgToJS/Profiling.hs
@@ -19,6 +19,8 @@ module GHC.StgToJS.Profiling
   , profiling
   , ifProfiling
   , ifProfilingM
+  -- * helpers
+  , profStat
   )
 where
 
@@ -124,6 +126,9 @@ ifProfilingM m = do
     prof <- profiling
     if prof then m else return mempty
 
+-- | If profiling is enabled, then use input JStat, else ignore
+profStat :: StgToJSConfig -> JStat -> JStat
+profStat cfg e = if csProf cfg then e else mempty
 --------------------------------------------------------------------------------
 -- Generating cost-centre and cost-centre stack variables
 
diff --git a/compiler/GHC/StgToJS/Regs.hs b/compiler/GHC/StgToJS/Regs.hs
index b03bb87907..e8f62a39ad 100644
--- a/compiler/GHC/StgToJS/Regs.hs
+++ b/compiler/GHC/StgToJS/Regs.hs
@@ -5,8 +5,12 @@ module GHC.StgToJS.Regs
   , Special(..)
   , sp
   , stack
-  , r1
+  , r1, r2, r3, r4
   , StgRet (..)
+  , jsRegToInt
+  , intToJSReg
+  , maxReg
+  , minReg
   )
 where
 
@@ -20,6 +24,18 @@ import qualified GHC.Data.ShortText as ST
 import Data.Array
 import Data.Char
 
+-- FIXME: Perf: Jeff (2022,03): as far as I can tell, we never pattern match on
+-- these registers and make heavy use of the Enum, Bounded, and Ix, instances.
+-- This heavily implies to me that we should be using something like: StgReg =
+-- StgReg { unStgReg :: Int8# } and then store two nibbles in a single byte. Not
+-- only would this be more memory efficient, but it would also allow for
+-- optimizations such as pointer tagging and avoiding chasing the info table,
+-- although I'm not sure if this would really benefit the backend as currently
+-- written. Other than that a newtype wrapper with a custom bounded instance
+-- (hand written or deriving via) would be better. In almost all functions that
+-- take an StgReg we use either the Bounded or the Enum methods, thus we likely
+-- don't gain anything from having these registers explicitly represented in
+-- data constructors.
 -- | General purpose "registers"
 --
 -- The JS backend arbitrarily supports 128 registers
@@ -75,9 +91,26 @@ sp = toJExpr Sp
 stack :: JExpr
 stack = toJExpr Stack
 
-r1 :: JExpr
+r1, r2, r3, r4 :: JExpr
 r1 = toJExpr R1
+r2 = toJExpr R2
+r3 = toJExpr R3
+r4 = toJExpr R4
 
+
+-- FIXME: Jeff (2022,03): remove these serialization functions after adding a
+-- StgReg type with a proper bounded and enum instance
+jsRegToInt :: StgReg -> Int
+jsRegToInt = (+1) . fromEnum
+
+intToJSReg :: Int -> StgReg
+intToJSReg r = toEnum (r - 1)
+
+maxReg :: Int
+maxReg = jsRegToInt maxBound
+
+minReg :: Int
+minReg = jsRegToInt minBound
 ---------------------------------------------------
 -- caches
 ---------------------------------------------------
diff --git a/compiler/GHC/StgToJS/Types.hs b/compiler/GHC/StgToJS/Types.hs
index e0d6e9c86c..02b09a0a7d 100644
--- a/compiler/GHC/StgToJS/Types.hs
+++ b/compiler/GHC/StgToJS/Types.hs
@@ -1,3 +1,6 @@
+{-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
 module GHC.StgToJS.Types where
 
 import GHC.Prelude
@@ -16,7 +19,7 @@ import GHC.Types.ForeignCall
 import GHC.Types.SrcLoc
 
 import GHC.Utils.Monad.State.Strict
-import GHC.Utils.Outputable (Outputable (..), text)
+import GHC.Utils.Outputable (Outputable (..), text, SDocContext)
 
 import GHC.Data.ShortText
 
@@ -52,6 +55,7 @@ data GenGroupState = GenGroupState
   }
 
 data StgToJSConfig = StgToJSConfig
+  -- flags
   { csInlinePush      :: !Bool
   , csInlineBlackhole :: !Bool
   , csInlineLoadRegs  :: !Bool
@@ -63,6 +67,8 @@ data StgToJSConfig = StgToJSConfig
   , csTraceForeign    :: !Bool
   , csProf            :: !Bool -- ^ Profiling enabled
   , csRuntimeAssert   :: !Bool -- ^ Enable runtime assertions
+  -- settings
+  , csContext         :: !SDocContext
   }
 
 data ClosureInfo = ClosureInfo
@@ -104,10 +110,19 @@ data CIType
   | CIStackFrame
   deriving (Eq, Ord)
 
-data CIStatic
-  = -- CIStaticParent { staticParent :: Ident } -- ^ static refs are stored in parent in fungroup
-    CIStaticRefs   { staticRefs :: [ShortText] } -- ^ list of refs that need to be kept alive
-  deriving (Eq, Ord)
+-- | Static references that must be kept alive
+newtype CIStatic = CIStaticRefs { staticRefs :: [ShortText] }
+  deriving stock   (Eq, Ord)
+  deriving newtype (Semigroup, Monoid)
+
+-- TODO: Jeff (2022,03): Make ToJExpr derivable? will need Default Signatures
+-- and depends on the increase in compilation time
+
+-- | static refs: array = references, null = nothing to report
+--   note: only works after all top-level objects have been created
+instance ToJExpr CIStatic where
+  toJExpr (CIStaticRefs [])  = null_ -- [je| null |]
+  toJExpr (CIStaticRefs rs)  = toJExpr (map TxtI rs)
 
 -- function argument and free variable types
 data VarType
@@ -123,6 +138,9 @@ data VarType
   | ArrV     -- boxed array
   deriving (Eq, Ord, Enum, Bounded)
 
+instance ToJExpr VarType where
+  toJExpr = toJExpr . fromEnum
+
 data IdType
   = IdPlain
   | IdEntry
@@ -247,8 +265,8 @@ data ExprResult
   | ExprInline (Maybe [JExpr])
   deriving (Eq, Ord, Show)
 
-data ExprValData = ExprValData [JExpr]
-  deriving (Eq, Ord, Show)
+newtype ExprValData = ExprValData [JExpr]
+  deriving newtype (Eq, Ord, Show)
 
 
 
diff --git a/compiler/GHC/StgToJS/UnitUtils.hs b/compiler/GHC/StgToJS/UnitUtils.hs
index 2eb37ca72d..61886f43f0 100644
--- a/compiler/GHC/StgToJS/UnitUtils.hs
+++ b/compiler/GHC/StgToJS/UnitUtils.hs
@@ -7,11 +7,13 @@ module GHC.StgToJS.UnitUtils
   )
 where
 
-import GHC.Prelude
+
 import GHC.Data.ShortText as ST
 import GHC.Unit.Module
 import GHC.Utils.Encoding
 
+import GHC.Prelude
+
 unitModuleString :: Module -> String
 unitModuleString mod = mconcat
   [ unitIdString (moduleUnitId mod)
@@ -19,8 +21,8 @@ unitModuleString mod = mconcat
   , moduleNameString (moduleName mod)
   ]
 
--- | the global linkable unit of a module exports this symbol, depend on it to include that unit
---   (used for cost centres)
+-- | the global linkable unit of a module exports this symbol, depend on it to
+--   include that unit (used for cost centres)
 moduleGlobalSymbol :: Module -> ShortText
 moduleGlobalSymbol m = mconcat
   [ "h$"
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 0ca1aed531..dd0a9d20de 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -512,6 +512,9 @@ Library
         GHC.JS.Ppr
         GHC.JS.Syntax
         GHC.JS.Transform
+        GHC.JS.Rts.Types
+        GHC.JS.Rts.Apply
+        GHC.JS.Rts.Rts
         GHC.Linker
         GHC.Linker.Dynamic
         GHC.Linker.ExtraObj
author	doyougnu <jeffrey.young@iohk.io>	2022-03-04 10:32:56 -0500
committer	doyougnu <jeffrey.young@iohk.io>	2022-06-13 13:42:36 -0400
commit	e5cb7c869cfde63a1b3fc49b458e0a48e2a20b6c (patch)
tree	40becf2c33bbf75b04897143630f53c6ce88465e
parent	c785dd78159dd3f1d25a8f86079cb6e06f48a707 (diff)
download	haskell-e5cb7c869cfde63a1b3fc49b458e0a48e2a20b6c.tar.gz