js: split JMacro into JS eDSL and JS syntax

This commit:

Splits JExpr and JStat into two nearly identical DSLs:
- GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a
value cannot be unsaturated, or, a value of this DSL is a witness that a
value of GHC.JS.Unsat has been saturated
- GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation.

Then all binary and outputable instances are changed to use
GHC.JS.Syntax.

This moves us closer to closing out #22736 and #22352. See #22736 for
roadmap.

-------------------------
Metric Increase:
    CoOpt_Read
    LargeRecord
    ManyAlternatives
    PmSeriesS
    PmSeriesT
    PmSeriesV
    T10421
    T10858
    T11195
    T11374
    T11822
    T12227
    T12707
    T13035
    T13253
    T13253-spj
    T13379
    T14683
    T15164
    T15703
    T16577
    T17096
    T17516
    T17836
    T18140
    T18282
    T18304
    T18478
    T18698a
    T18698b
    T18923
    T1969
    T19695
    T20049
    T21839c
    T3064
    T4801
    T5321FD
    T5321Fun
    T5631
    T5642
    T783
    T9198
    T9233
    T9630
    TcPlugin_RewritePerf
    WWRec
-------------------------

5 files changed, 735 insertions, 229 deletions

diff --git a/compiler/GHC/JS/Make.hs b/compiler/GHC/JS/Make.hs
index f57643094c..8b06198a83 100644
--- a/compiler/GHC/JS/Make.hs
+++ b/compiler/GHC/JS/Make.hs
@@ -131,7 +131,7 @@ where
 
 import GHC.Prelude hiding ((.|.))
 
-import GHC.JS.Syntax
+import GHC.JS.Unsat.Syntax
 
 import Control.Arrow ((***))
 
diff --git a/compiler/GHC/JS/Ppr.hs b/compiler/GHC/JS/Ppr.hs
index 02529a928f..bb1acd9f51 100644
--- a/compiler/GHC/JS/Ppr.hs
+++ b/compiler/GHC/JS/Ppr.hs
@@ -56,11 +56,11 @@ x $$$ y = nest 2 $ x $+$ y
 -- | Render a syntax tree as a pretty-printable document
 -- (simply showing the resultant doc produces a nice,
 -- well formatted String).
-renderJs :: (JsToDoc a, JMacro a) => a -> Doc
+renderJs :: (JsToDoc a) => a -> Doc
 renderJs = renderJs' defaultRenderJs
 
-renderJs' :: (JsToDoc a, JMacro a) => RenderJs -> a -> Doc
-renderJs' r = jsToDocR r . jsSaturate Nothing
+renderJs' :: (JsToDoc a) => RenderJs -> a -> Doc
+renderJs' r = jsToDocR r
 
 data RenderJs = RenderJs
   { renderJsS :: !(RenderJs -> JStat -> Doc)
@@ -78,11 +78,11 @@ jsToDoc = jsToDocR defaultRenderJs
 -- | Render a syntax tree as a pretty-printable document, using a given prefix
 -- to all generated names. Use this with distinct prefixes to ensure distinct
 -- generated names between independent calls to render(Prefix)Js.
-renderPrefixJs :: (JsToDoc a, JMacro a) => FastString -> a -> Doc
-renderPrefixJs pfx = renderPrefixJs' defaultRenderJs pfx
+renderPrefixJs :: (JsToDoc a, JMacro a) => a -> Doc
+renderPrefixJs = renderPrefixJs' defaultRenderJs
 
-renderPrefixJs' :: (JsToDoc a, JMacro a) => RenderJs -> FastString -> a -> Doc
-renderPrefixJs' r pfx = jsToDocR r . jsSaturate (Just $ "jmId_" `mappend` pfx)
+renderPrefixJs' :: (JsToDoc a, JMacro a) => RenderJs -> a -> Doc
+renderPrefixJs' r = jsToDocR r
 
 braceNest :: Doc -> Doc
 braceNest x = char '{' <+> nest 2 x $$ char '}'
@@ -108,15 +108,14 @@ instance JsToDoc [JStat] where
 defRenderJsS :: RenderJs -> JStat -> Doc
 defRenderJsS r = \case
   IfStat cond x y -> hangBrace (text "if" <> parens (jsToDocR r cond))
-                               (jsToDocR r x)
-                     $$ mbElse
+                      (jsToDocR r x)
+                      $$ mbElse
         where mbElse | y == BlockStat []  = PP.empty
                      | otherwise = hangBrace (text "else") (jsToDocR r y)
   DeclStat x Nothing  -> text "var" <+> jsToDocR r x
   DeclStat x (Just e) -> text "var" <+> jsToDocR r x <+> char '=' <+> jsToDocR r e
   WhileStat False p b -> hangBrace (text "while" <> parens (jsToDocR r p)) (jsToDocR r b)
   WhileStat True  p b -> (hangBrace (text "do") (jsToDocR r b)) $+$ text "while" <+> parens (jsToDocR r p)
-  UnsatBlock e        -> jsToDocR r $ pseudoSaturate e
   BreakStat l         -> maybe (text "break")    (\(LexicalFastString s) -> (text "break"    <+> ftext s)) l
   ContinueStat l      -> maybe (text "continue") (\(LexicalFastString s) -> (text "continue" <+> ftext s)) l
   LabelStat (LexicalFastString l) s -> ftext l <> char ':' $$ printBS s
@@ -150,7 +149,7 @@ defRenderJsS r = \case
     --                             });
     --
     ValExpr (JFunc is b) -> sep [jsToDocR r i <+> text "= function" <> parens (hsep . punctuate comma . map (jsToDocR r) $ is) <> char '{', nest 2 (jsToDocR r b), text "}"]
-    _                    -> jsToDocR r i <+> char '=' <+> jsToDocR r x
+    _                      -> jsToDocR r i <+> char '=' <+> jsToDocR r x
   UOpStat op x
     | isPre op && isAlphaOp op -> ftext (uOpText op) <+> optParens r x
     | isPre op                 -> ftext (uOpText op) <> optParens r x
@@ -160,8 +159,8 @@ defRenderJsS r = \case
 flattenBlocks :: [JStat] -> [JStat]
 flattenBlocks = \case
   BlockStat y:ys -> flattenBlocks y ++ flattenBlocks ys
-  y:ys           -> y : flattenBlocks ys
-  []             -> []
+  y:ys            -> y : flattenBlocks ys
+  []              -> []
 
 optParens :: RenderJs -> JExpr -> Doc
 optParens r x = case x of
@@ -180,7 +179,6 @@ defRenderJsE r = \case
     | isPre op                 -> ftext (uOpText op) <> optParens r x
     | otherwise                -> optParens r x <> ftext (uOpText op)
   ApplExpr je xs -> jsToDocR r je <> (parens . hsep . punctuate comma $ map (jsToDocR r) xs)
-  UnsatExpr e    -> jsToDocR r $ pseudoSaturate e
 
 defRenderJsV :: RenderJs -> JVal -> Doc
 defRenderJsV r = \case
@@ -202,7 +200,6 @@ defRenderJsV r = \case
                           -- because we sort the elements lexically
                           $ sortOn (LexicalFastString . fst) (nonDetEltsUniqMap m)
   JFunc is b -> parens $ hangBrace (text "function" <> parens (hsep . punctuate comma . map (jsToDocR r) $ is)) (jsToDocR r b)
-  UnsatVal f -> jsToDocR r $ pseudoSaturate f
 
 defRenderJsI :: RenderJs -> Ident -> Doc
 defRenderJsI _ (TxtI t) = ftext t
@@ -235,7 +232,7 @@ encodeJsonChar = \case
             let h = showHex cp ""
             in  text (prefix ++ replicate (pad - length h) '0' ++ h)
 
-uOpText :: JUOp -> FastString
+uOpText :: UOp -> FastString
 uOpText = \case
   NotOp     -> "!"
   BNotOp    -> "~"
@@ -251,7 +248,7 @@ uOpText = \case
   PreDecOp  -> "--"
   PostDecOp -> "--"
 
-opText :: JOp -> FastString
+opText :: Op -> FastString
 opText = \case
   EqOp          -> "=="
   StrictEqOp    -> "==="
@@ -278,13 +275,13 @@ opText = \case
   InOp          -> "in"
 
 
-isPre :: JUOp -> Bool
+isPre :: UOp -> Bool
 isPre = \case
   PostIncOp -> False
   PostDecOp -> False
   _         -> True
 
-isAlphaOp :: JUOp -> Bool
+isAlphaOp :: UOp -> Bool
 isAlphaOp = \case
   NewOp    -> True
   TypeofOp -> True
diff --git a/compiler/GHC/JS/Syntax.hs b/compiler/GHC/JS/Syntax.hs
index 66067ced9e..0b8a6c05b2 100644
--- a/compiler/GHC/JS/Syntax.hs
+++ b/compiler/GHC/JS/Syntax.hs
@@ -48,92 +48,60 @@
 --     GHC.StgToJS.\*. Please see 'GHC.JS.Make' for a module which provides
 --     helper functions that use the deeply embedded DSL defined in this module
 --     to provide some of the benefits of a shallow embedding.
+--
 -----------------------------------------------------------------------------
+
 module GHC.JS.Syntax
   ( -- * Deeply embedded JS datatypes
     JStat(..)
   , JExpr(..)
   , JVal(..)
-  , JOp(..)
-  , JUOp(..)
+  , Op(..)
+  , UOp(..)
   , Ident(..)
-  , identFS
-  , JsLabel
+  , JLabel
   -- * pattern synonyms over JS operators
-  , pattern New
-  , pattern Not
-  , pattern Negate
-  , pattern Add
-  , pattern Sub
-  , pattern Mul
-  , pattern Div
-  , pattern Mod
-  , pattern BOr
-  , pattern BAnd
-  , pattern BXor
-  , pattern BNot
-  , pattern LOr
-  , pattern LAnd
-  , pattern Int
-  , pattern String
-  , pattern PreInc
-  , pattern PostInc
-  , pattern PreDec
-  , pattern PostDec
-  -- * Ident supply
-  , IdentSupply(..)
-  , newIdentSupply
-  , pseudoSaturate
+  , pattern JNew
+  , pattern JNot
+  , pattern JNegate
+  , pattern JAdd
+  , pattern JSub
+  , pattern JMul
+  , pattern JDiv
+  , pattern JMod
+  , pattern JBOr
+  , pattern JBAnd
+  , pattern JBXor
+  , pattern JBNot
+  , pattern JLOr
+  , pattern JLAnd
+  , pattern SatInt
+  , pattern JString
+  , pattern JPreInc
+  , pattern JPostInc
+  , pattern JPreDec
+  , pattern JPostDec
   -- * Utility
   , SaneDouble(..)
+  , jassignAll
+  , jassignAllEqual
+  , jvar
   ) where
 
 import GHC.Prelude
 
+import GHC.JS.Unsat.Syntax (Ident(..))
+import GHC.Data.FastString
+import GHC.Types.Unique.Map
+import GHC.Utils.Misc
+
 import Control.DeepSeq
 
-import Data.Function
 import Data.Data
-import Data.Word
 import qualified Data.Semigroup as Semigroup
 
 import GHC.Generics
 
-import GHC.Data.FastString
-import GHC.Utils.Monad.State.Strict
-import GHC.Types.Unique
-import GHC.Types.Unique.Map
-
--- | A supply of identifiers, possibly empty
-newtype IdentSupply a
-  = IS {runIdentSupply :: State [Ident] a}
-  deriving Typeable
-
-instance NFData (IdentSupply a) where rnf IS{} = ()
-
-inIdentSupply :: (State [Ident] a -> State [Ident] b) -> IdentSupply a -> IdentSupply b
-inIdentSupply f x = IS $ f (runIdentSupply x)
-
-instance Functor IdentSupply where
-    fmap f x = inIdentSupply (fmap f) x
-
-newIdentSupply :: Maybe FastString -> [Ident]
-newIdentSupply Nothing    = newIdentSupply (Just "jmId")
-newIdentSupply (Just pfx) = [ TxtI (mconcat [pfx,"_",mkFastString (show x)])
-                            | x <- [(0::Word64)..]
-                            ]
-
--- | Given a Pseudo-saturate a value with garbage @<<unsatId>>@ identifiers.
-pseudoSaturate :: IdentSupply a -> a
-pseudoSaturate x = evalState (runIdentSupply x) $ newIdentSupply (Just "<<unsatId>>")
-
-instance Eq a => Eq (IdentSupply a) where
-    (==) = (==) `on` pseudoSaturate
-instance Ord a => Ord (IdentSupply a) where
-    compare = compare `on` pseudoSaturate
-instance Show a => Show (IdentSupply a) where
-    show x = "(" ++ show (pseudoSaturate x) ++ ")"
-
 
 --------------------------------------------------------------------------------
 --                            Statements
@@ -142,26 +110,25 @@ instance Show a => Show (IdentSupply a) where
 -- Reference](https://tc39.es/ecma262/#sec-ecmascript-language-statements-and-declarations)
 -- for details
 data JStat
-  = DeclStat   !Ident !(Maybe JExpr)         -- ^ Variable declarations: var foo [= e]
-  | ReturnStat JExpr                         -- ^ Return
-  | IfStat     JExpr JStat JStat             -- ^ If
-  | WhileStat  Bool JExpr JStat              -- ^ While, bool is "do" when True
-  | ForInStat  Bool Ident JExpr JStat        -- ^ For-in, bool is "each' when True
+  = DeclStat   !Ident !(Maybe JExpr)     -- ^ Variable declarations: var foo [= e]
+  | ReturnStat JExpr                     -- ^ Return
+  | IfStat     JExpr JStat JStat   -- ^ If
+  | WhileStat  Bool JExpr JStat       -- ^ While, bool is "do" when True
+  | ForInStat  Bool Ident JExpr JStat -- ^ For-in, bool is "each' when True
   | SwitchStat JExpr [(JExpr, JStat)] JStat  -- ^ Switch
-  | TryStat    JStat Ident JStat JStat       -- ^ Try
-  | BlockStat  [JStat]                       -- ^ Blocks
-  | ApplStat   JExpr [JExpr]                 -- ^ Application
-  | UOpStat JUOp JExpr                       -- ^ Unary operators
-  | AssignStat JExpr JExpr                   -- ^ Binding form: @foo = bar@
-  | UnsatBlock (IdentSupply JStat)           -- ^ /Unsaturated/ blocks see 'pseudoSaturate'
-  | LabelStat JsLabel JStat                  -- ^ Statement Labels, makes me nostalgic for qbasic
-  | BreakStat (Maybe JsLabel)                -- ^ Break
-  | ContinueStat (Maybe JsLabel)             -- ^ Continue
+  | TryStat    JStat Ident JStat JStat -- ^ Try
+  | BlockStat  [JStat]                   -- ^ Blocks
+  | ApplStat   JExpr [JExpr]          -- ^ Application
+  | UOpStat UOp JExpr                -- ^ Unary operators
+  | AssignStat JExpr JExpr            -- ^ Binding form: @foo = bar@
+  | LabelStat JLabel JStat               -- ^ Statement Labels, makes me nostalgic for qbasic
+  | BreakStat (Maybe JLabel)                -- ^ Break
+  | ContinueStat (Maybe JLabel)             -- ^ Continue
   deriving (Eq, Typeable, Generic)
 
 -- | A Label used for 'JStat', specifically 'BreakStat', 'ContinueStat' and of
 -- course 'LabelStat'
-type JsLabel = LexicalFastString
+type JLabel = LexicalFastString
 
 instance Semigroup JStat where
   (<>) = appendJStat
@@ -178,10 +145,10 @@ appendJStat :: JStat -> JStat -> JStat
 appendJStat mx my = case (mx,my) of
   (BlockStat [] , y           ) -> y
   (x            , BlockStat []) -> x
-  (BlockStat xs , BlockStat ys) -> BlockStat $ xs ++ ys
-  (BlockStat xs , ys          ) -> BlockStat $ xs ++ [ys]
-  (xs           , BlockStat ys) -> BlockStat $ xs : ys
-  (xs           , ys          ) -> BlockStat [xs,ys]
+  (BlockStat xs , BlockStat ys) -> BlockStat $! xs ++ ys
+  (BlockStat xs , ys          )  -> BlockStat $! xs ++ [ys]
+  (xs           , BlockStat ys)  -> BlockStat $! xs : ys
+  (xs           , ys          )   -> BlockStat [xs,ys]
 
 
 --------------------------------------------------------------------------------
@@ -189,16 +156,13 @@ appendJStat mx my = case (mx,my) of
 --------------------------------------------------------------------------------
 -- | JavaScript Expressions
 data JExpr
-  = ValExpr    JVal                 -- ^ All values are trivially expressions
-  | SelExpr    JExpr Ident          -- ^ Selection: Obj.foo, see 'GHC.JS.Make..^'
+  = ValExpr    JVal                    -- ^ All values are trivially expressions
+  | SelExpr    JExpr Ident             -- ^ Selection: Obj.foo, see 'GHC.JS.Make..^'
   | IdxExpr    JExpr JExpr          -- ^ Indexing:  Obj[foo], see 'GHC.JS.Make..!'
-  | InfixExpr  JOp JExpr JExpr      -- ^ Infix Expressions, see 'JExpr'
-                                    --   pattern synonyms
-  | UOpExpr    JUOp JExpr           -- ^ Unary Expressions
-  | IfExpr     JExpr JExpr JExpr    -- ^ If-expression
+  | InfixExpr  Op JExpr JExpr   -- ^ Infix Expressions, see 'JExpr' pattern synonyms
+  | UOpExpr    UOp JExpr           -- ^ Unary Expressions
+  | IfExpr     JExpr JExpr JExpr -- ^ If-expression
   | ApplExpr   JExpr [JExpr]        -- ^ Application
-  | UnsatExpr  (IdentSupply JExpr)  -- ^ An /Unsaturated/ expression.
-                                    --   See 'pseudoSaturate'
   deriving (Eq, Typeable, Generic)
 
 -- * Useful pattern synonyms to ease programming with the deeply embedded JS
@@ -207,110 +171,110 @@ data JExpr
 --   and Integer literals.
 
 -- | pattern synonym for a unary operator new
-pattern New :: JExpr -> JExpr
-pattern New x = UOpExpr NewOp x
+pattern JNew :: JExpr -> JExpr
+pattern JNew x = UOpExpr NewOp x
 
 -- | pattern synonym for prefix increment @++x@
-pattern PreInc :: JExpr -> JExpr
-pattern PreInc x = UOpExpr PreIncOp x
+pattern JPreInc :: JExpr -> JExpr
+pattern JPreInc x = UOpExpr PreIncOp x
 
 -- | pattern synonym for postfix increment @x++@
-pattern PostInc :: JExpr -> JExpr
-pattern PostInc x = UOpExpr PostIncOp x
+pattern JPostInc :: JExpr -> JExpr
+pattern JPostInc x = UOpExpr PostIncOp x
 
 -- | pattern synonym for prefix decrement @--x@
-pattern PreDec :: JExpr -> JExpr
-pattern PreDec x = UOpExpr PreDecOp x
+pattern JPreDec :: JExpr -> JExpr
+pattern JPreDec x = UOpExpr PreDecOp x
 
 -- | pattern synonym for postfix decrement @--x@
-pattern PostDec :: JExpr -> JExpr
-pattern PostDec x = UOpExpr PostDecOp x
+pattern JPostDec :: JExpr -> JExpr
+pattern JPostDec x = UOpExpr PostDecOp x
 
 -- | pattern synonym for logical not @!@
-pattern Not :: JExpr -> JExpr
-pattern Not x = UOpExpr NotOp x
+pattern JNot :: JExpr -> JExpr
+pattern JNot x = UOpExpr NotOp x
 
 -- | pattern synonym for unary negation @-@
-pattern Negate :: JExpr -> JExpr
-pattern Negate x = UOpExpr NegOp x
+pattern JNegate :: JExpr -> JExpr
+pattern JNegate x = UOpExpr NegOp x
 
 -- | pattern synonym for addition @+@
-pattern Add :: JExpr -> JExpr -> JExpr
-pattern Add x y = InfixExpr AddOp x y
+pattern JAdd :: JExpr -> JExpr -> JExpr
+pattern JAdd x y = InfixExpr AddOp x y
 
 -- | pattern synonym for subtraction @-@
-pattern Sub :: JExpr -> JExpr -> JExpr
-pattern Sub x y = InfixExpr SubOp x y
+pattern JSub :: JExpr -> JExpr -> JExpr
+pattern JSub x y = InfixExpr SubOp x y
 
 -- | pattern synonym for multiplication @*@
-pattern Mul :: JExpr -> JExpr -> JExpr
-pattern Mul x y = InfixExpr MulOp x y
+pattern JMul :: JExpr -> JExpr -> JExpr
+pattern JMul x y = InfixExpr MulOp x y
 
 -- | pattern synonym for division @*@
-pattern Div :: JExpr -> JExpr -> JExpr
-pattern Div x y = InfixExpr DivOp x y
+pattern JDiv :: JExpr -> JExpr -> JExpr
+pattern JDiv x y = InfixExpr DivOp x y
 
 -- | pattern synonym for remainder @%@
-pattern Mod :: JExpr -> JExpr -> JExpr
-pattern Mod x y = InfixExpr ModOp x y
+pattern JMod :: JExpr -> JExpr -> JExpr
+pattern JMod x y = InfixExpr ModOp x y
 
 -- | pattern synonym for Bitwise Or @|@
-pattern BOr :: JExpr -> JExpr -> JExpr
-pattern BOr x y = InfixExpr BOrOp x y
+pattern JBOr :: JExpr -> JExpr -> JExpr
+pattern JBOr x y = InfixExpr BOrOp x y
 
 -- | pattern synonym for Bitwise And @&@
-pattern BAnd :: JExpr -> JExpr -> JExpr
-pattern BAnd x y = InfixExpr BAndOp x y
+pattern JBAnd :: JExpr -> JExpr -> JExpr
+pattern JBAnd x y = InfixExpr BAndOp x y
 
 -- | pattern synonym for Bitwise XOr @^@
-pattern BXor :: JExpr -> JExpr -> JExpr
-pattern BXor x y = InfixExpr BXorOp x y
+pattern JBXor :: JExpr -> JExpr -> JExpr
+pattern JBXor x y = InfixExpr BXorOp x y
 
 -- | pattern synonym for Bitwise Not @~@
-pattern BNot :: JExpr -> JExpr
-pattern BNot x = UOpExpr BNotOp x
+pattern JBNot :: JExpr -> JExpr
+pattern JBNot x = UOpExpr BNotOp x
 
 -- | pattern synonym for logical Or @||@
-pattern LOr :: JExpr -> JExpr -> JExpr
-pattern LOr x y = InfixExpr LOrOp x y
+pattern JLOr :: JExpr -> JExpr -> JExpr
+pattern JLOr x y = InfixExpr LOrOp x y
 
 -- | pattern synonym for logical And @&&@
-pattern LAnd :: JExpr -> JExpr -> JExpr
-pattern LAnd x y = InfixExpr LAndOp x y
-
+pattern JLAnd :: JExpr -> JExpr -> JExpr
+pattern JLAnd x y = InfixExpr LAndOp x y
 
 -- | pattern synonym to create integer values
-pattern Int :: Integer -> JExpr
-pattern Int x = ValExpr (JInt x)
+pattern SatInt :: Integer -> JExpr
+pattern SatInt x = ValExpr (JInt x)
 
 -- | pattern synonym to create string values
-pattern String :: FastString -> JExpr
-pattern String x = ValExpr (JStr x)
+pattern JString :: FastString -> JExpr
+pattern JString x = ValExpr (JStr x)
 
 
 --------------------------------------------------------------------------------
 --                            Values
 --------------------------------------------------------------------------------
+
 -- | JavaScript values
 data JVal
-  = JVar     Ident                      -- ^ A variable reference
-  | JList    [JExpr]                    -- ^ A JavaScript list, or what JS
-                                        --   calls an Array
-  | JDouble  SaneDouble                 -- ^ A Double
-  | JInt     Integer                    -- ^ A BigInt
-  | JStr     FastString                 -- ^ A String
-  | JRegEx   FastString                 -- ^ A Regex
+  = JVar     Ident        -- ^ A variable reference
+  | JList    [JExpr]      -- ^ A JavaScript list, or what JS calls an Array
+  | JDouble  SaneDouble   -- ^ A Double
+  | JInt     Integer      -- ^ A BigInt
+  | JStr     FastString   -- ^ A String
+  | JRegEx   FastString   -- ^ A Regex
   | JHash    (UniqMap FastString JExpr) -- ^ A JS HashMap: @{"foo": 0}@
-  | JFunc    [Ident] JStat              -- ^ A function
-  | UnsatVal (IdentSupply JVal)         -- ^ An /Unsaturated/ value, see 'pseudoSaturate'
+  | JFunc    [Ident] JStat             -- ^ A function
   deriving (Eq, Typeable, Generic)
 
+
 --------------------------------------------------------------------------------
 --                            Operators
 --------------------------------------------------------------------------------
+
 -- | JS Binary Operators. We do not deeply embed the comma operator and the
 -- assignment operators
-data JOp
+data Op
   = EqOp            -- ^ Equality:              `==`
   | StrictEqOp      -- ^ Strict Equality:       `===`
   | NeqOp           -- ^ InEquality:            `!=`
@@ -336,10 +300,10 @@ data JOp
   | InOp            -- ^ @in@
   deriving (Show, Eq, Ord, Enum, Data, Typeable, Generic)
 
-instance NFData JOp
+instance NFData Op
 
 -- | JS Unary Operators
-data JUOp
+data UOp
   = NotOp           -- ^ Logical Not: @!@
   | BNotOp          -- ^ Bitwise Not: @~@
   | NegOp           -- ^ Negation:    @-@
@@ -355,7 +319,7 @@ data JUOp
   | PostDecOp       -- ^ Postfix Decrement: @x--@
   deriving (Show, Eq, Ord, Enum, Data, Typeable, Generic)
 
-instance NFData JUOp
+instance NFData UOp
 
 -- | A newtype wrapper around 'Double' to ensure we never generate a 'Double'
 -- that becomes a 'NaN', see 'Eq SaneDouble', 'Ord SaneDouble' for details on
@@ -376,17 +340,16 @@ instance Ord SaneDouble where
 instance Show SaneDouble where
     show (SaneDouble x) = show x
 
-
 --------------------------------------------------------------------------------
---                            Identifiers
+--                            Helper Functions
 --------------------------------------------------------------------------------
--- We use FastString for identifiers in JS backend
 
--- | A newtype wrapper around 'FastString' for JS identifiers.
-newtype Ident = TxtI { itxt :: FastString }
- deriving stock   (Show, Eq)
- deriving newtype (Uniquable)
+jassignAllEqual :: [JExpr] -> [JExpr] -> JStat
+jassignAllEqual xs ys = mconcat (zipWithEqual "assignAllEqual" AssignStat xs ys)
+
+jassignAll :: [JExpr] -> [JExpr] -> JStat
+jassignAll xs ys = mconcat (zipWith AssignStat xs ys)
+
+jvar :: FastString -> JExpr
+jvar = ValExpr . JVar . TxtI
 
-identFS :: Ident -> FastString
-identFS = \case
-  TxtI fs -> fs
diff --git a/compiler/GHC/JS/Transform.hs b/compiler/GHC/JS/Transform.hs
index 72b3980537..9051c04fbf 100644
--- a/compiler/GHC/JS/Transform.hs
+++ b/compiler/GHC/JS/Transform.hs
@@ -8,10 +8,7 @@
 {-# LANGUAGE BlockArguments #-}
 
 module GHC.JS.Transform
-  ( mapIdent
-  , mapStatIdent
-  , mapExprIdent
-  , identsS
+  ( identsS
   , identsV
   , identsE
   -- * Saturation
@@ -24,68 +21,25 @@ module GHC.JS.Transform
   , composOpM
   , composOpM_
   , composOpFold
+  , satJExpr
+  , satJStat
+  , unsatJStat
   )
 where
 
 import GHC.Prelude
 
-import GHC.JS.Syntax
+import qualified GHC.JS.Syntax as Sat
+import GHC.JS.Unsat.Syntax
 
 import Data.Functor.Identity
 import Control.Monad
-import Data.Bifunctor
+import Control.Arrow ((***))
 
 import GHC.Data.FastString
 import GHC.Utils.Monad.State.Strict
 import GHC.Types.Unique.Map
 
-mapExprIdent :: (Ident -> JExpr) -> JExpr -> JExpr
-mapExprIdent f = fst (mapIdent f)
-
-mapStatIdent :: (Ident -> JExpr) -> JStat -> JStat
-mapStatIdent f = snd (mapIdent f)
-
--- | Map on every variable ident
-mapIdent :: (Ident -> JExpr) -> (JExpr -> JExpr, JStat -> JStat)
-mapIdent f = (map_expr, map_stat)
-  where
-    map_expr = \case
-      ValExpr    v        -> map_val v
-      SelExpr    e i      -> SelExpr (map_expr e) i
-      IdxExpr    e1 e2    -> IdxExpr (map_expr e1) (map_expr e2)
-      InfixExpr  o e1 e2  -> InfixExpr o (map_expr e1) (map_expr e2)
-      UOpExpr    o e      -> UOpExpr o (map_expr e)
-      IfExpr     e1 e2 e3 -> IfExpr (map_expr e1) (map_expr e2) (map_expr e3)
-      ApplExpr   e es     -> ApplExpr (map_expr e) (fmap map_expr es)
-      UnsatExpr  me       -> UnsatExpr (fmap map_expr me)
-
-    map_val v = case v of
-      JVar     i  -> f i
-      JList    es -> ValExpr $ JList (fmap map_expr es)
-      JDouble{}   -> ValExpr $ v
-      JInt{}      -> ValExpr $ v
-      JStr{}      -> ValExpr $ v
-      JRegEx{}    -> ValExpr $ v
-      JHash me    -> ValExpr $ JHash (fmap map_expr me)
-      JFunc is s  -> ValExpr $ JFunc is (map_stat s)
-      UnsatVal v2 -> ValExpr $ UnsatVal v2
-
-    map_stat s = case s of
-      DeclStat i e          -> DeclStat i (fmap map_expr e)
-      ReturnStat e          -> ReturnStat (map_expr e)
-      IfStat     e s1 s2    -> IfStat (map_expr e) (map_stat s1) (map_stat s2)
-      WhileStat  b e s2     -> WhileStat b (map_expr e) (map_stat s2)
-      ForInStat  b i e s2   -> ForInStat b i (map_expr e) (map_stat s2)
-      SwitchStat e les s2   -> SwitchStat (map_expr e) (fmap (bimap map_expr map_stat) les) (map_stat s2)
-      TryStat    s2 i s3 s4 -> TryStat (map_stat s2) i (map_stat s3) (map_stat s4)
-      BlockStat  ls         -> BlockStat (fmap map_stat ls)
-      ApplStat   e es       -> ApplStat (map_expr e) (fmap map_expr es)
-      UOpStat    o e        -> UOpStat o (map_expr e)
-      AssignStat e1 e2      -> AssignStat (map_expr e1) (map_expr e2)
-      UnsatBlock ms         -> UnsatBlock (fmap map_stat ms)
-      LabelStat  l s2       -> LabelStat l (map_stat s2)
-      BreakStat{}           -> s
-      ContinueStat{}        -> s
 
 {-# INLINE identsS #-}
 identsS :: JStat -> [Ident]
@@ -262,3 +216,203 @@ jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e)
                JMGExpr (UnsatExpr  us) -> go =<< (JMGExpr <$> runIdentSupply us)
                JMGVal  (UnsatVal   us) -> go =<< (JMGVal  <$> runIdentSupply us)
                _ -> composOpM go v
+
+
+--------------------------------------------------------------------------------
+--                            Translation
+--
+-- This will be moved after GHC.JS.Syntax is removed
+--------------------------------------------------------------------------------
+satJStat :: JStat -> Sat.JStat
+satJStat = witness . proof
+  where proof = jsSaturate Nothing
+
+        -- This is an Applicative but we can't use it because no type variables :(
+        witness :: JStat -> Sat.JStat
+        witness (DeclStat i rhs)      = Sat.DeclStat i (fmap satJExpr rhs)
+        witness (ReturnStat e)        = Sat.ReturnStat (satJExpr e)
+        witness (IfStat c t e)        = Sat.IfStat (satJExpr c) (witness t) (witness e)
+        witness (WhileStat is_do c e) = Sat.WhileStat is_do (satJExpr c) (witness e)
+        witness (ForInStat is_each i iter body) = Sat.ForInStat is_each i
+                                                  (satJExpr iter)
+                                                  (witness body)
+        witness (SwitchStat struct ps def) = Sat.SwitchStat
+                                             (satJExpr struct)
+                                             (map (satJExpr *** witness) ps)
+                                             (witness def)
+        witness (TryStat t i c f)     = Sat.TryStat (witness t) i (witness c) (witness f)
+        witness (BlockStat bs)        = Sat.BlockStat $! fmap witness bs
+        witness (ApplStat rator rand) = Sat.ApplStat (satJExpr rator) (satJExpr <$> rand)
+        witness (UOpStat rator rand)  = Sat.UOpStat  (satJUOp rator) (satJExpr rand)
+        witness (AssignStat lhs rhs)  = Sat.AssignStat (satJExpr lhs) (satJExpr rhs)
+        witness (LabelStat lbl stmt)  = Sat.LabelStat lbl (witness stmt)
+        witness (BreakStat Nothing)   = Sat.BreakStat Nothing
+        witness (BreakStat (Just l))  = Sat.BreakStat $! Just l
+        witness (ContinueStat Nothing)  = Sat.ContinueStat Nothing
+        witness (ContinueStat (Just l)) = Sat.ContinueStat $! Just l
+        witness UnsatBlock{}            = error "satJStat: discovered an Unsat...impossibly"
+
+
+satJExpr :: JExpr -> Sat.JExpr
+satJExpr = go
+  where
+    go (ValExpr v)        = Sat.ValExpr (satJVal v)
+    go (SelExpr obj i)    = Sat.SelExpr (satJExpr obj) i
+    go (IdxExpr o i)      = Sat.IdxExpr (satJExpr o) (satJExpr i)
+    go (InfixExpr op l r) = Sat.InfixExpr (satJOp op) (satJExpr l) (satJExpr r)
+    go (UOpExpr op r)     = Sat.UOpExpr (satJUOp op) (satJExpr r)
+    go (IfExpr c t e)     = Sat.IfExpr (satJExpr c) (satJExpr t) (satJExpr e)
+    go (ApplExpr rator rands) = Sat.ApplExpr (satJExpr rator) (satJExpr <$> rands)
+    go UnsatExpr{}        = error "satJExpr: discovered an Unsat...impossibly"
+
+satJOp :: JOp -> Sat.Op
+satJOp = go
+  where
+    go EqOp         = Sat.EqOp
+    go StrictEqOp   = Sat.StrictEqOp
+    go NeqOp        = Sat.NeqOp
+    go StrictNeqOp  = Sat.StrictNeqOp
+    go GtOp         = Sat.GtOp
+    go GeOp         = Sat.GeOp
+    go LtOp         = Sat.LtOp
+    go LeOp         = Sat.LeOp
+    go AddOp        = Sat.AddOp
+    go SubOp        = Sat.SubOp
+    go MulOp        = Sat.MulOp
+    go DivOp        = Sat.DivOp
+    go ModOp        = Sat.ModOp
+    go LeftShiftOp  = Sat.LeftShiftOp
+    go RightShiftOp = Sat.RightShiftOp
+    go ZRightShiftOp = Sat.ZRightShiftOp
+    go BAndOp       = Sat.BAndOp
+    go BOrOp        = Sat.BOrOp
+    go BXorOp       = Sat.BXorOp
+    go LAndOp       = Sat.LAndOp
+    go LOrOp        = Sat.LOrOp
+    go InstanceofOp = Sat.InstanceofOp
+    go InOp         = Sat.InOp
+
+satJUOp :: JUOp -> Sat.UOp
+satJUOp = go
+  where
+    go NotOp     = Sat.NotOp
+    go BNotOp    = Sat.BNotOp
+    go NegOp     = Sat.NegOp
+    go PlusOp    = Sat.PlusOp
+    go NewOp     = Sat.NewOp
+    go TypeofOp  = Sat.TypeofOp
+    go DeleteOp  = Sat.DeleteOp
+    go YieldOp   = Sat.YieldOp
+    go VoidOp    = Sat.VoidOp
+    go PreIncOp  = Sat.PreIncOp
+    go PostIncOp = Sat.PostIncOp
+    go PreDecOp  = Sat.PreDecOp
+    go PostDecOp = Sat.PostDecOp
+
+satJVal :: JVal -> Sat.JVal
+satJVal = go
+  where
+    go (JVar i)    = Sat.JVar i
+    go (JList xs)  = Sat.JList (satJExpr <$> xs)
+    go (JDouble d) = Sat.JDouble (Sat.SaneDouble (unSaneDouble d))
+    go (JInt i)    = Sat.JInt   i
+    go (JStr f)    = Sat.JStr   f
+    go (JRegEx f)  = Sat.JRegEx f
+    go (JHash m)   = Sat.JHash (satJExpr <$> m)
+    go (JFunc args body) = Sat.JFunc args (satJStat body)
+    go UnsatVal{} = error "jvalToSatVar: discovered an Sat...impossibly"
+
+unsatJStat :: Sat.JStat -> JStat
+unsatJStat = go_back
+  where
+        -- This is an Applicative but we can't use it because no type variables :(
+        go_back :: Sat.JStat -> JStat
+        go_back (Sat.DeclStat i rhs)      = DeclStat i (fmap unsatJExpr rhs)
+        go_back (Sat.ReturnStat e)        = ReturnStat (unsatJExpr e)
+        go_back (Sat.IfStat c t e)        = IfStat (unsatJExpr c) (go_back t) (go_back e)
+        go_back (Sat.WhileStat is_do c e) = WhileStat is_do (unsatJExpr c) (go_back e)
+        go_back (Sat.ForInStat is_each i iter body) = ForInStat is_each i
+                                                  (unsatJExpr iter)
+                                                  (go_back body)
+        go_back (Sat.SwitchStat struct ps def) = SwitchStat
+                                             (unsatJExpr struct)
+                                             (map (unsatJExpr *** go_back) ps)
+                                             (go_back def)
+        go_back (Sat.TryStat t i c f)     = TryStat (go_back t) i (go_back c) (go_back f)
+        go_back (Sat.BlockStat bs)        = BlockStat $! fmap go_back bs
+        go_back (Sat.ApplStat rator rand) = ApplStat (unsatJExpr rator) (unsatJExpr <$> rand)
+        go_back (Sat.UOpStat rator rand)  = UOpStat  (unsatJUOp rator) (unsatJExpr rand)
+        go_back (Sat.AssignStat lhs rhs)  = AssignStat (unsatJExpr lhs) (unsatJExpr rhs)
+        go_back (Sat.LabelStat lbl stmt)  = LabelStat lbl (go_back stmt)
+        go_back (Sat.BreakStat Nothing)   = BreakStat Nothing
+        go_back (Sat.BreakStat (Just l))  = BreakStat $! Just l
+        go_back (Sat.ContinueStat Nothing)  = ContinueStat Nothing
+        go_back (Sat.ContinueStat (Just l)) = ContinueStat $! Just l
+
+
+unsatJExpr :: Sat.JExpr -> JExpr
+unsatJExpr = go
+  where
+    go (Sat.ValExpr v)        = ValExpr (unsatJVal v)
+    go (Sat.SelExpr obj i)    = SelExpr (unsatJExpr obj) i
+    go (Sat.IdxExpr o i)      = IdxExpr (unsatJExpr o) (unsatJExpr i)
+    go (Sat.InfixExpr op l r) = InfixExpr (satOpToJOp op) (unsatJExpr l) (unsatJExpr r)
+    go (Sat.UOpExpr op r)     = UOpExpr (unsatJUOp op) (unsatJExpr r)
+    go (Sat.IfExpr c t e)     = IfExpr (unsatJExpr c) (unsatJExpr t) (unsatJExpr e)
+    go (Sat.ApplExpr rator rands) = ApplExpr (unsatJExpr rator) (unsatJExpr <$> rands)
+
+satOpToJOp :: Sat.Op -> JOp
+satOpToJOp = go
+  where
+    go Sat.EqOp         = EqOp
+    go Sat.StrictEqOp   = StrictEqOp
+    go Sat.NeqOp        = NeqOp
+    go Sat.StrictNeqOp  = StrictNeqOp
+    go Sat.GtOp         = GtOp
+    go Sat.GeOp         = GeOp
+    go Sat.LtOp         = LtOp
+    go Sat.LeOp         = LeOp
+    go Sat.AddOp        = AddOp
+    go Sat.SubOp        = SubOp
+    go Sat.MulOp        = MulOp
+    go Sat.DivOp        = DivOp
+    go Sat.ModOp        = ModOp
+    go Sat.LeftShiftOp  = LeftShiftOp
+    go Sat.RightShiftOp = RightShiftOp
+    go Sat.ZRightShiftOp = ZRightShiftOp
+    go Sat.BAndOp       = BAndOp
+    go Sat.BOrOp        = BOrOp
+    go Sat.BXorOp       = BXorOp
+    go Sat.LAndOp       = LAndOp
+    go Sat.LOrOp        = LOrOp
+    go Sat.InstanceofOp = InstanceofOp
+    go Sat.InOp         = InOp
+
+unsatJUOp :: Sat.UOp -> JUOp
+unsatJUOp = go
+  where
+    go Sat.NotOp     = NotOp
+    go Sat.BNotOp    = BNotOp
+    go Sat.NegOp     = NegOp
+    go Sat.PlusOp    = PlusOp
+    go Sat.NewOp     = NewOp
+    go Sat.TypeofOp  = TypeofOp
+    go Sat.DeleteOp  = DeleteOp
+    go Sat.YieldOp   = YieldOp
+    go Sat.VoidOp    = VoidOp
+    go Sat.PreIncOp  = PreIncOp
+    go Sat.PostIncOp = PostIncOp
+    go Sat.PreDecOp  = PreDecOp
+    go Sat.PostDecOp = PostDecOp
+
+unsatJVal :: Sat.JVal -> JVal
+unsatJVal = go
+  where
+    go (Sat.JVar i)    = JVar i
+    go (Sat.JList xs)  = JList (unsatJExpr <$> xs)
+    go (Sat.JDouble d) = JDouble (SaneDouble (Sat.unSaneDouble d))
+    go (Sat.JInt i)    = JInt   i
+    go (Sat.JStr f)    = JStr   f
+    go (Sat.JRegEx f)  = JRegEx f
+    go (Sat.JHash m)   = JHash (unsatJExpr <$> m)
+    go (Sat.JFunc args body) = JFunc args (unsatJStat body)
diff --git a/compiler/GHC/JS/Unsat/Syntax.hs b/compiler/GHC/JS/Unsat/Syntax.hs
new file mode 100644
index 0000000000..f5ab076aa5
--- /dev/null
+++ b/compiler/GHC/JS/Unsat/Syntax.hs
@@ -0,0 +1,392 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE PatternSynonyms #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.JS.Unsat.Syntax
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Jeffrey Young  <jeffrey.young@iohk.io>
+--                Luite Stegeman <luite.stegeman@iohk.io>
+--                Sylvain Henry  <sylvain.henry@iohk.io>
+--                Josh Meredith  <josh.meredith@iohk.io>
+-- Stability   :  experimental
+--
+--
+-- * Domain and Purpose
+--
+--     GHC.JS.Unsat.Syntax defines the Syntax for the JS backend in GHC. It
+--     comports with the [ECMA-262](https://tc39.es/ecma262/) although not every
+--     production rule of the standard is represented. Code in this module is a
+--     fork of [JMacro](https://hackage.haskell.org/package/jmacro) (BSD 3
+--     Clause) by Gershom Bazerman, heavily modified to accomodate GHC's
+--     constraints.
+--
+--
+-- * Strategy
+--
+--     Nothing fancy in this module, this is a classic deeply embeded AST for
+--     JS. We define numerous ADTs and pattern synonyms to make pattern matching
+--     and constructing ASTs easier.
+--
+--
+-- * Consumers
+--
+--     The entire JS backend consumes this module, e.g., the modules in
+--     GHC.StgToJS.\*. Please see 'GHC.JS.Make' for a module which provides
+--     helper functions that use the deeply embedded DSL defined in this module
+--     to provide some of the benefits of a shallow embedding.
+-----------------------------------------------------------------------------
+module GHC.JS.Unsat.Syntax
+  ( -- * Deeply embedded JS datatypes
+    JStat(..)
+  , JExpr(..)
+  , JVal(..)
+  , JOp(..)
+  , JUOp(..)
+  , Ident(..)
+  , identFS
+  , JsLabel
+  -- * pattern synonyms over JS operators
+  , pattern New
+  , pattern Not
+  , pattern Negate
+  , pattern Add
+  , pattern Sub
+  , pattern Mul
+  , pattern Div
+  , pattern Mod
+  , pattern BOr
+  , pattern BAnd
+  , pattern BXor
+  , pattern BNot
+  , pattern LOr
+  , pattern LAnd
+  , pattern Int
+  , pattern String
+  , pattern PreInc
+  , pattern PostInc
+  , pattern PreDec
+  , pattern PostDec
+  -- * Ident supply
+  , IdentSupply(..)
+  , newIdentSupply
+  , pseudoSaturate
+  -- * Utility
+  , SaneDouble(..)
+  ) where
+
+import GHC.Prelude
+
+import Control.DeepSeq
+
+import Data.Function
+import Data.Data
+import Data.Word
+import qualified Data.Semigroup as Semigroup
+
+import GHC.Generics
+
+import GHC.Data.FastString
+import GHC.Utils.Monad.State.Strict
+import GHC.Types.Unique
+import GHC.Types.Unique.Map
+
+-- | A supply of identifiers, possibly empty
+newtype IdentSupply a
+  = IS {runIdentSupply :: State [Ident] a}
+  deriving Typeable
+
+instance NFData (IdentSupply a) where rnf IS{} = ()
+
+inIdentSupply :: (State [Ident] a -> State [Ident] b) -> IdentSupply a -> IdentSupply b
+inIdentSupply f x = IS $ f (runIdentSupply x)
+
+instance Functor IdentSupply where
+    fmap f x = inIdentSupply (fmap f) x
+
+newIdentSupply :: Maybe FastString -> [Ident]
+newIdentSupply Nothing    = newIdentSupply (Just "jmId")
+newIdentSupply (Just pfx) = [ TxtI (mconcat [pfx,"_",mkFastString (show x)])
+                            | x <- [(0::Word64)..]
+                            ]
+
+-- | Given a Pseudo-saturate a value with garbage @<<unsatId>>@ identifiers.
+pseudoSaturate :: IdentSupply a -> a
+pseudoSaturate x = evalState (runIdentSupply x) $ newIdentSupply (Just "<<unsatId>>")
+
+instance Eq a => Eq (IdentSupply a) where
+    (==) = (==) `on` pseudoSaturate
+instance Ord a => Ord (IdentSupply a) where
+    compare = compare `on` pseudoSaturate
+instance Show a => Show (IdentSupply a) where
+    show x = "(" ++ show (pseudoSaturate x) ++ ")"
+
+
+--------------------------------------------------------------------------------
+--                            Statements
+--------------------------------------------------------------------------------
+-- | JavaScript statements, see the [ECMA262
+-- Reference](https://tc39.es/ecma262/#sec-ecmascript-language-statements-and-declarations)
+-- for details
+data JStat
+  = DeclStat   !Ident !(Maybe JExpr)         -- ^ Variable declarations: var foo [= e]
+  | ReturnStat JExpr                         -- ^ Return
+  | IfStat     JExpr JStat JStat             -- ^ If
+  | WhileStat  Bool JExpr JStat              -- ^ While, bool is "do" when True
+  | ForInStat  Bool Ident JExpr JStat        -- ^ For-in, bool is "each' when True
+  | SwitchStat JExpr [(JExpr, JStat)] JStat  -- ^ Switch
+  | TryStat    JStat Ident JStat JStat       -- ^ Try
+  | BlockStat  [JStat]                       -- ^ Blocks
+  | ApplStat   JExpr [JExpr]                 -- ^ Application
+  | UOpStat JUOp JExpr                       -- ^ Unary operators
+  | AssignStat JExpr JExpr                   -- ^ Binding form: @foo = bar@
+  | UnsatBlock (IdentSupply JStat)           -- ^ /Unsaturated/ blocks see 'pseudoSaturate'
+  | LabelStat JsLabel JStat                  -- ^ Statement Labels, makes me nostalgic for qbasic
+  | BreakStat (Maybe JsLabel)                -- ^ Break
+  | ContinueStat (Maybe JsLabel)             -- ^ Continue
+  deriving (Eq, Typeable, Generic)
+
+-- | A Label used for 'JStat', specifically 'BreakStat', 'ContinueStat' and of
+-- course 'LabelStat'
+type JsLabel = LexicalFastString
+
+instance Semigroup JStat where
+  (<>) = appendJStat
+
+instance Monoid JStat where
+  mempty = BlockStat []
+
+-- | Append a statement to another statement. 'appendJStat' only returns a
+-- 'JStat' that is /not/ a 'BlockStat' when either @mx@ or @my is an empty
+-- 'BlockStat'. That is:
+-- > (BlockStat [] , y           ) = y
+-- > (x            , BlockStat []) = x
+appendJStat :: JStat -> JStat -> JStat
+appendJStat mx my = case (mx,my) of
+  (BlockStat [] , y           ) -> y
+  (x            , BlockStat []) -> x
+  (BlockStat xs , BlockStat ys) -> BlockStat $ xs ++ ys
+  (BlockStat xs , ys          ) -> BlockStat $ xs ++ [ys]
+  (xs           , BlockStat ys) -> BlockStat $ xs : ys
+  (xs           , ys          ) -> BlockStat [xs,ys]
+
+
+--------------------------------------------------------------------------------
+--                            Expressions
+--------------------------------------------------------------------------------
+-- | JavaScript Expressions
+data JExpr
+  = ValExpr    JVal                 -- ^ All values are trivially expressions
+  | SelExpr    JExpr Ident          -- ^ Selection: Obj.foo, see 'GHC.JS.Make..^'
+  | IdxExpr    JExpr JExpr          -- ^ Indexing:  Obj[foo], see 'GHC.JS.Make..!'
+  | InfixExpr  JOp JExpr JExpr      -- ^ Infix Expressions, see 'JExpr'
+                                    --   pattern synonyms
+  | UOpExpr    JUOp JExpr           -- ^ Unary Expressions
+  | IfExpr     JExpr JExpr JExpr    -- ^ If-expression
+  | ApplExpr   JExpr [JExpr]        -- ^ Application
+  | UnsatExpr  (IdentSupply JExpr)  -- ^ An /Saturated/ expression.
+                                    --   See 'pseudoSaturate'
+  deriving (Eq, Typeable, Generic)
+
+-- * Useful pattern synonyms to ease programming with the deeply embedded JS
+--   AST. Each pattern wraps @JUOp@ and @JOp@ into a @JExpr@s to save typing and
+--   for convienience. In addition we include a string wrapper for JS string
+--   and Integer literals.
+
+-- | pattern synonym for a unary operator new
+pattern New :: JExpr -> JExpr
+pattern New x = UOpExpr NewOp x
+
+-- | pattern synonym for prefix increment @++x@
+pattern PreInc :: JExpr -> JExpr
+pattern PreInc x = UOpExpr PreIncOp x
+
+-- | pattern synonym for postfix increment @x++@
+pattern PostInc :: JExpr -> JExpr
+pattern PostInc x = UOpExpr PostIncOp x
+
+-- | pattern synonym for prefix decrement @--x@
+pattern PreDec :: JExpr -> JExpr
+pattern PreDec x = UOpExpr PreDecOp x
+
+-- | pattern synonym for postfix decrement @--x@
+pattern PostDec :: JExpr -> JExpr
+pattern PostDec x = UOpExpr PostDecOp x
+
+-- | pattern synonym for logical not @!@
+pattern Not :: JExpr -> JExpr
+pattern Not x = UOpExpr NotOp x
+
+-- | pattern synonym for unary negation @-@
+pattern Negate :: JExpr -> JExpr
+pattern Negate x = UOpExpr NegOp x
+
+-- | pattern synonym for addition @+@
+pattern Add :: JExpr -> JExpr -> JExpr
+pattern Add x y = InfixExpr AddOp x y
+
+-- | pattern synonym for subtraction @-@
+pattern Sub :: JExpr -> JExpr -> JExpr
+pattern Sub x y = InfixExpr SubOp x y
+
+-- | pattern synonym for multiplication @*@
+pattern Mul :: JExpr -> JExpr -> JExpr
+pattern Mul x y = InfixExpr MulOp x y
+
+-- | pattern synonym for division @*@
+pattern Div :: JExpr -> JExpr -> JExpr
+pattern Div x y = InfixExpr DivOp x y
+
+-- | pattern synonym for remainder @%@
+pattern Mod :: JExpr -> JExpr -> JExpr
+pattern Mod x y = InfixExpr ModOp x y
+
+-- | pattern synonym for Bitwise Or @|@
+pattern BOr :: JExpr -> JExpr -> JExpr
+pattern BOr x y = InfixExpr BOrOp x y
+
+-- | pattern synonym for Bitwise And @&@
+pattern BAnd :: JExpr -> JExpr -> JExpr
+pattern BAnd x y = InfixExpr BAndOp x y
+
+-- | pattern synonym for Bitwise XOr @^@
+pattern BXor :: JExpr -> JExpr -> JExpr
+pattern BXor x y = InfixExpr BXorOp x y
+
+-- | pattern synonym for Bitwise Not @~@
+pattern BNot :: JExpr -> JExpr
+pattern BNot x = UOpExpr BNotOp x
+
+-- | pattern synonym for logical Or @||@
+pattern LOr :: JExpr -> JExpr -> JExpr
+pattern LOr x y = InfixExpr LOrOp x y
+
+-- | pattern synonym for logical And @&&@
+pattern LAnd :: JExpr -> JExpr -> JExpr
+pattern LAnd x y = InfixExpr LAndOp x y
+
+
+-- | pattern synonym to create integer values
+pattern Int :: Integer -> JExpr
+pattern Int x = ValExpr (JInt x)
+
+-- | pattern synonym to create string values
+pattern String :: FastString -> JExpr
+pattern String x = ValExpr (JStr x)
+
+
+--------------------------------------------------------------------------------
+--                            Values
+--------------------------------------------------------------------------------
+-- | JavaScript values
+data JVal
+  = JVar     Ident                      -- ^ A variable reference
+  | JList    [JExpr]                    -- ^ A JavaScript list, or what JS
+                                        --   calls an Array
+  | JDouble  SaneDouble                 -- ^ A Double
+  | JInt     Integer                    -- ^ A BigInt
+  | JStr     FastString                 -- ^ A String
+  | JRegEx   FastString                 -- ^ A Regex
+  | JHash    (UniqMap FastString JExpr) -- ^ A JS HashMap: @{"foo": 0}@
+  | JFunc    [Ident] JStat              -- ^ A function
+  | UnsatVal (IdentSupply JVal)         -- ^ An /Saturated/ value, see 'pseudoSaturate'
+  deriving (Eq, Typeable, Generic)
+
+--------------------------------------------------------------------------------
+--                            Operators
+--------------------------------------------------------------------------------
+-- | JS Binary Operators. We do not deeply embed the comma operator and the
+-- assignment operators
+data JOp
+  = EqOp            -- ^ Equality:              `==`
+  | StrictEqOp      -- ^ Strict Equality:       `===`
+  | NeqOp           -- ^ InEquality:            `!=`
+  | StrictNeqOp     -- ^ Strict InEquality      `!==`
+  | GtOp            -- ^ Greater Than:          `>`
+  | GeOp            -- ^ Greater Than or Equal: `>=`
+  | LtOp            -- ^ Less Than:             <
+  | LeOp            -- ^ Less Than or Equal:     <=
+  | AddOp           -- ^ Addition:               +
+  | SubOp           -- ^ Subtraction:            -
+  | MulOp           -- ^ Multiplication          \*
+  | DivOp           -- ^ Division:               \/
+  | ModOp           -- ^ Remainder:              %
+  | LeftShiftOp     -- ^ Left Shift:             \<\<
+  | RightShiftOp    -- ^ Right Shift:            \>\>
+  | ZRightShiftOp   -- ^ Unsigned RightShift:    \>\>\>
+  | BAndOp          -- ^ Bitwise And:            &
+  | BOrOp           -- ^ Bitwise Or:             |
+  | BXorOp          -- ^ Bitwise XOr:            ^
+  | LAndOp          -- ^ Logical And:            &&
+  | LOrOp           -- ^ Logical Or:             ||
+  | InstanceofOp    -- ^ @instanceof@
+  | InOp            -- ^ @in@
+  deriving (Show, Eq, Ord, Enum, Data, Typeable, Generic)
+
+instance NFData JOp
+
+-- | JS Unary Operators
+data JUOp
+  = NotOp           -- ^ Logical Not: @!@
+  | BNotOp          -- ^ Bitwise Not: @~@
+  | NegOp           -- ^ Negation:    @-@
+  | PlusOp          -- ^ Unary Plus:  @+x@
+  | NewOp           -- ^ new    x
+  | TypeofOp        -- ^ typeof x
+  | DeleteOp        -- ^ delete x
+  | YieldOp         -- ^ yield  x
+  | VoidOp          -- ^ void   x
+  | PreIncOp        -- ^ Prefix Increment:  @++x@
+  | PostIncOp       -- ^ Postfix Increment: @x++@
+  | PreDecOp        -- ^ Prefix Decrement:  @--x@
+  | PostDecOp       -- ^ Postfix Decrement: @x--@
+  deriving (Show, Eq, Ord, Enum, Data, Typeable, Generic)
+
+instance NFData JUOp
+
+-- | A newtype wrapper around 'Double' to ensure we never generate a 'Double'
+-- that becomes a 'NaN', see 'Eq SaneDouble', 'Ord SaneDouble' for details on
+-- Sane-ness
+newtype SaneDouble = SaneDouble
+  { unSaneDouble :: Double
+  }
+  deriving (Data, Typeable, Fractional, Num, Generic, NFData)
+
+instance Eq SaneDouble where
+    (SaneDouble x) == (SaneDouble y) = x == y || (isNaN x && isNaN y)
+
+instance Ord SaneDouble where
+    compare (SaneDouble x) (SaneDouble y) = compare (fromNaN x) (fromNaN y)
+        where fromNaN z | isNaN z = Nothing
+                        | otherwise = Just z
+
+instance Show SaneDouble where
+    show (SaneDouble x) = show x
+
+
+--------------------------------------------------------------------------------
+--                            Identifiers
+--------------------------------------------------------------------------------
+-- We use FastString for identifiers in JS backend
+
+-- | A newtype wrapper around 'FastString' for JS identifiers.
+newtype Ident = TxtI { itxt :: FastString }
+ deriving stock   (Show, Eq)
+ deriving newtype (Uniquable)
+
+identFS :: Ident -> FastString
+identFS = \case
+  TxtI fs -> fs