6 files changed, 466 insertions, 97 deletions

diff --git a/compiler/GHC/JS/Make.hs b/compiler/GHC/JS/Make.hs
index 8b06198a83..85651647bc 100644
--- a/compiler/GHC/JS/Make.hs
+++ b/compiler/GHC/JS/Make.hs
@@ -83,7 +83,7 @@ module GHC.JS.Make
   -- $intro_funcs
   , var
   , jString
-  , jLam, jVar, jFor, jForIn, jForEachIn, jTryCatchFinally
+  , jLam, jFunction, jVar, jFor, jForNoDecl, jForIn, jForEachIn, jTryCatchFinally
   -- * Combinators
   -- $combinators
   , (||=), (|=), (.==.), (.===.), (.!=.), (.!==.), (.!)
@@ -253,7 +253,7 @@ jLam f = ValExpr . UnsatVal . IS $ do
 -- of the enclosed expression. The result is a block statement.
 -- Usage:
 --
--- @jVar $ \x y -> mconcat [jVar x ||= one_, jVar y ||= two_, jVar x + jVar y]@
+-- @jVar $ \x y -> mconcat [x ||= one_, y ||= two_, x + y]@
 jVar :: ToSat a => a -> JStat
 jVar f = UnsatBlock . IS $ do
            (block, is) <- runIdentSupply $ toSat_ f []
@@ -262,6 +262,9 @@ jVar f = UnsatBlock . IS $ do
                addDecls x = x
            return $ addDecls block
 
+jFunction :: Ident -> [Ident] -> JStat -> JStat
+jFunction name args body = FuncStat name args body
+
 -- | Create a 'for in' statement.
 -- Usage:
 --
@@ -279,6 +282,23 @@ jForEachIn e f = UnsatBlock . IS $ do
                let i = head is
                return $ decl i `mappend` ForInStat True i e block
 
+-- | Create a 'for' statement given a function for initialization, a predicate
+-- to step to, a step and a body
+-- Usage:
+--
+-- @ jFor (|= zero_) (.<. Int 65536) preIncrS
+--        (\j -> ...something with the counter j...)@
+--
+jFor :: (JExpr -> JStat)
+     -> (JExpr -> JExpr)
+     -> (JExpr -> JStat)
+     -> (JExpr -> JStat)
+     -> JStat
+jFor init pred step body = jVar $ \i -> ForStat (init i) (pred i) (step i) (body i)
+
+jForNoDecl :: Ident -> JExpr -> JExpr -> JStat -> JStat -> JStat
+jForNoDecl i initial p step body = ForStat (toJExpr i |= initial) p step body
+
 -- | As with "jForIn" but creating a \"for each in\" statement.
 jTryCatchFinally :: (ToSat a) => JStat -> a -> JStat -> JStat
 jTryCatchFinally s f s2 = UnsatBlock . IS $ do
@@ -294,13 +314,6 @@ var = ValExpr . JVar . TxtI
 jString :: FastString -> JExpr
 jString = toJExpr
 
--- | Create a 'for' statement
-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 Nothing
diff --git a/compiler/GHC/JS/Optimizer.hs b/compiler/GHC/JS/Optimizer.hs
new file mode 100644
index 0000000000..211e6bbd07
--- /dev/null
+++ b/compiler/GHC/JS/Optimizer.hs
@@ -0,0 +1,271 @@
+{-# LANGUAGE LambdaCase #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.JS.Optimizer
+-- 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.Optimizer is a shallow embedding of a peephole optimizer. That is,
+--     this module defines transformations over the JavaScript IR in
+--     'GHC.JS.Syntax', transforming the IR forms from inefficient, or
+--     non-idiomatic, JavaScript to more efficient and idiomatic JavaScript. The
+--     optimizer is written in continuation passing style so optimizations
+--     compose.
+--
+-- * Architecture of the optimizer
+--
+--    The design is that each optimization pattern matches on the head of a
+--    block by pattern matching onto the head of the stream of nodes in the
+--    JavaScript IR. If an optimization gets a successful match then it performs
+--    whatever rewrite is necessary and then calls the 'loop' continuation. This
+--    ensures that the result of the optimization is subject to the same
+--    optimization, /and/ the rest of the optimizations. If there is no match
+--    then the optimization should call the 'next' continuation to pass the
+--    stream to the next optimization in the optimization chain. We then define
+--    the last "optimization" to be @tailLoop@ which selects the next block of
+--    code to optimize and begin the optimization pipeline again.
+-----------------------------------------------------------------------------
+module GHC.JS.Optimizer
+ ( jsOptimize
+ ) where
+
+
+import Prelude
+
+import GHC.JS.Syntax
+
+import Control.Arrow
+
+{-
+Note [ Unsafe JavaScript Optimizations ]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+There are a number of optimizations that the JavaScript Backend performs that
+are not sound with respect to arbritrary JavaScript. We still perform these
+optimizations because we are not optimizing arbritrary javascript and under the
+assumption that the JavaScript backend will not generate code that violates the
+soundness of the optimizer. For example, the @deadCodeElim@ optimization removes
+all statements that occur after a 'return' in JavaScript, however this is not
+always sound because of hoisting, consider this program:
+
+  function foo() {
+    var x = 2;
+    bar();
+    return x;
+
+    function bar() {
+      x = 10;
+  }}
+
+  which is transformed to:
+
+  function foo() {
+    var x = 2;
+    bar();
+    return x;
+  }}
+
+The optimized form is clearly a program that goes wrong because `bar()` is no
+longer defined. But the JavaScript backend will never generate this code, so as
+long as that assumption holds we are safe to perform optimizations that would
+normally be unsafe.
+-}
+
+
+--------------------------------------------------------------------------------
+--                        Top level Driver
+--------------------------------------------------------------------------------
+jsOptimize :: JStat -> JStat
+jsOptimize = go
+  where
+    p_opt = jsOptimize
+    opt   = jsOptimize'
+    e_opt = jExprOptimize
+    -- base case
+    go (BlockStat xs) = BlockStat (opt xs)
+    -- recursive cases
+    go (ForStat i p s body)   = ForStat (go i) (e_opt p) (go s) (p_opt body)
+    go (ForInStat b i p body) = ForInStat b i p (p_opt body)
+    go (WhileStat b c body)   = WhileStat b (e_opt c) (p_opt body)
+    go (SwitchStat s ps body) = SwitchStat s (fmap (second go) ps) (p_opt body)
+    go (FuncStat i args body) = FuncStat i args (p_opt body)
+    go (IfStat c t e)         = IfStat (e_opt c) (p_opt t) (p_opt e)
+    go (TryStat ths i c f)    = TryStat (p_opt ths) i (p_opt c) (p_opt f)
+    go (LabelStat lbl s)      = LabelStat lbl (p_opt s)
+    -- special case: drive the optimizer into expressions
+    go (AssignStat id op rhs) = AssignStat (e_opt id) op (e_opt rhs)
+    go (DeclStat i (Just e))  = DeclStat i (Just $ e_opt e)
+    go (ReturnStat e)         = ReturnStat (e_opt e)
+    go (UOpStat op e)         = UOpStat op (e_opt e)
+    go (ApplStat f args)      = ApplStat   (e_opt f) (e_opt <$> args)
+    -- all else is terminal, we match on these to force a warning in the event
+    -- another constructor is added
+    go x@BreakStat{}          = x
+    go x@ContinueStat{}       = x
+    go x@DeclStat{}           = x -- match on the nothing case
+
+jsOptimize' :: [JStat] -> [JStat]
+jsOptimize' = runBlockOpt opts . single_pass_opts
+  where
+    opts :: BlockOpt
+    opts =  safe_opts
+            <> unsafe_opts
+            <> tailLoop  -- tailloop must be last, see module description
+
+    unsafe_opts :: BlockOpt
+    unsafe_opts = mconcat [ deadCodeElim ]
+
+    safe_opts :: BlockOpt
+    safe_opts = mconcat [ declareAssign, combineOps ]
+
+    single_pass_opts :: BlockTrans
+    single_pass_opts = runBlockTrans sp_opts
+
+    sp_opts = [flattenBlocks]
+
+-- | recur over a @JExpr@ and optimize the @JVal@s
+jExprOptimize :: JExpr -> JExpr
+-- the base case
+jExprOptimize (ValExpr val)       = ValExpr (jValOptimize val)
+-- recursive cases
+jExprOptimize (SelExpr obj field) = SelExpr (jExprOptimize obj) field
+jExprOptimize (IdxExpr obj ix)    = IdxExpr (jExprOptimize obj) (jExprOptimize ix)
+jExprOptimize (UOpExpr op exp)    = UOpExpr op (jExprOptimize exp)
+jExprOptimize (IfExpr c t e)      = IfExpr c (jExprOptimize t) (jExprOptimize e)
+jExprOptimize (ApplExpr f args )  = ApplExpr (jExprOptimize f) (jExprOptimize <$> args)
+jExprOptimize (InfixExpr op l r)  = InfixExpr op (jExprOptimize l) (jExprOptimize r)
+
+-- | drive optimizations to anonymous functions and over expressions
+jValOptimize ::  JVal -> JVal
+-- base case
+jValOptimize (JFunc args body) = JFunc args (jsOptimize body)
+-- recursive cases
+jValOptimize (JList exprs)     = JList (jExprOptimize <$> exprs)
+jValOptimize (JHash hash)      = JHash (jExprOptimize <$> hash)
+-- all else is terminal
+jValOptimize x@JVar{}          = x
+jValOptimize x@JDouble{}       = x
+jValOptimize x@JInt{}          = x
+jValOptimize x@JStr{}          = x
+jValOptimize x@JRegEx{}        = x
+
+-- | A block transformation is a function from a stream of syntax to another
+-- stream
+type BlockTrans = [JStat] -> [JStat]
+
+-- | A BlockOpt is a function that alters the stream, and a continuation that
+-- represents the rest of the stream. The first @BlockTrans@ represents
+-- restarting the optimizer after a change has happened. The second @BlockTrans@
+-- represents the rest of the continuation stream.
+newtype BlockOpt = BlockOpt (BlockTrans -> BlockTrans -> BlockTrans)
+
+-- | To merge two BlockOpt we first run the left-hand side optimization and
+-- capture the right-hand side in the continuation
+instance Semigroup BlockOpt where
+  BlockOpt opt0 <> BlockOpt opt1 = BlockOpt
+    $ \loop next -> opt0 loop (opt1 loop next)
+
+instance Monoid BlockOpt where
+  -- don't loop, just finalize
+  mempty = BlockOpt $ \_loop next -> next
+
+-- | loop until a fixpoint is reached
+runBlockOpt :: BlockOpt -> [JStat] -> [JStat]
+runBlockOpt (BlockOpt opt) xs = recur xs
+  where recur = opt recur id
+
+runBlockTrans :: [BlockTrans] -> [JStat] -> [JStat]
+runBlockTrans opts = foldl (.) id opts
+
+-- | Perform all the optimizations on the tail of a block.
+tailLoop :: BlockOpt
+tailLoop = BlockOpt $ \loop next -> \case
+    []     -> next []
+    -- this call to jsOptimize is required or else the optimizer will not
+    -- properly recur down JStat. See the 'deadCodeElim' test for examples which
+    -- were failing before this change
+    (x:xs) -> next (jsOptimize x : loop xs)
+
+--------------------------------------------------------------------------------
+--                        Single Slot Optimizations
+--------------------------------------------------------------------------------
+
+{- |
+   Catch modify and assign operators:
+      case 1:
+        i = i + 1; ==> ++i;
+      case 2:
+        i = i - 1; ==> --i;
+      case 3:
+        i = i + n; ==> i += n;
+      case 4:
+        i = i - n; ==> i -= n;
+-}
+combineOps :: BlockOpt
+combineOps = BlockOpt $ \loop next ->
+  \case
+    -- find a op pattern, and rerun the optimizer on its result unless there is
+    -- nothing to optimize, in which case call the next optimization
+    (unchanged@(AssignStat
+                  ident@(ValExpr (JVar i))
+                  AssignOp
+                  (InfixExpr op (ValExpr (JVar i')) e)) : xs)
+      | i == i' -> case (op, e) of
+                     (AddOp, (ValExpr (JInt 1))) -> loop $ UOpStat PreIncOp ident          : xs
+                     (SubOp, (ValExpr (JInt 1))) -> loop $ UOpStat PreDecOp ident          : xs
+                     (AddOp, e')                 -> loop $ AssignStat ident AddAssignOp e' : xs
+                     (SubOp, e')                 -> loop $ AssignStat ident SubAssignOp e' : xs
+                     _                           -> next $ unchanged : xs
+    -- commutative cases
+    (unchanged@(AssignStat
+                  ident@(ValExpr (JVar i))
+                  AssignOp
+                  (InfixExpr op e (ValExpr (JVar i')))) : xs)
+      | i == i' -> case (op, e) of
+                     (AddOp, (ValExpr (JInt 1))) -> loop $ UOpStat PreIncOp ident          : xs
+                     (SubOp, (ValExpr (JInt 1))) -> loop $ UOpStat PreDecOp ident          : xs
+                     (AddOp, e')                 -> loop $ AssignStat ident AddAssignOp e' : xs
+                     (SubOp, e')                 -> loop $ AssignStat ident SubAssignOp e' : xs
+                     _                           -> next $ unchanged : xs
+    -- general case, we had nothing to optimize in this case so call the next
+    -- optimization
+    xs -> next xs
+
+
+--------------------------------------------------------------------------------
+--                        Dual Slot Optimizations
+--------------------------------------------------------------------------------
+-- | Catch 'var i; i = q;' ==> 'var i = q;'
+declareAssign :: BlockOpt
+declareAssign = BlockOpt $
+  \loop next -> \case
+    ( (DeclStat i Nothing)
+      : (AssignStat (ValExpr (JVar i')) AssignOp v)
+      : xs
+      )  | i == i' -> loop (DeclStat i (Just v) : xs)
+    xs -> next xs
+
+-- | Eliminate all code after a return statement. This is a special case
+-- optimization that doesn't need to loop. See Note [Unsafe JavaScript
+-- optimizations]
+deadCodeElim :: BlockOpt
+deadCodeElim = BlockOpt $
+  \_loop next -> \case
+    (x@ReturnStat{}:_) -> next [x]
+    xs                 -> next xs
+
+-- | remove nested blocks
+flattenBlocks :: BlockTrans
+flattenBlocks (BlockStat y : ys) = flattenBlocks y ++ flattenBlocks ys
+flattenBlocks (x:xs)             = x : flattenBlocks xs
+flattenBlocks []                 = []
diff --git a/compiler/GHC/JS/Ppr.hs b/compiler/GHC/JS/Ppr.hs
index 9315156eeb..5f3dd737e7 100644
--- a/compiler/GHC/JS/Ppr.hs
+++ b/compiler/GHC/JS/Ppr.hs
@@ -10,10 +10,46 @@
 -- For Outputable instances for JS syntax
 {-# OPTIONS_GHC -Wno-orphans #-}
 
--- | Pretty-printing JavaScript
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.JS.Ppr
+-- 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.Ppr defines the code generation facilities for the JavaScript
+--     backend. That is, this module exports a function from the JS backend IR
+--     to JavaScript compliant concrete syntax that can readily be executed by
+--     nodejs or called in a browser.
+--
+-- * Design
+--
+--     This module follows the architecture and style of the other backends in
+--     GHC: it intances Outputable for the relevant types, creates a class that
+--     describes a morphism from the IR domain to JavaScript concrete Syntax and
+--     then generates that syntax on a case by case basis.
+--
+-- * How to use
+--
+--     The key functions are @renderJS@, @jsToDoc@, and the @RenderJS@ record.
+--     Use the @RenderJS@ record and @jsToDoc@ to define a custom renderers for
+--     specific parts of the backend, for example in 'GHC.StgToJS.Linker.Opt' a
+--     custom renderer ensures all @Ident@ generated by the linker optimization
+--     pass are prefixed differently than the default. Use @renderJS@ to
+--     generate JavaScript concrete syntax in the general case, suitable for
+--     human consumption.
+-----------------------------------------------------------------------------
+
 module GHC.JS.Ppr
   ( renderJs
-  , renderJs'
   , renderPrefixJs
   , renderPrefixJs'
   , JsToDoc(..)
@@ -21,9 +57,10 @@ module GHC.JS.Ppr
   , RenderJs(..)
   , jsToDoc
   , pprStringLit
-  , flattenBlocks
   , braceNest
   , hangBrace
+  , interSemi
+  , addSemi
   )
 where
 
@@ -49,9 +86,9 @@ instance Outputable JExpr where
 instance Outputable JVal where
   ppr = docToSDoc . renderJs
 
-
-($$$) :: Doc -> Doc -> Doc
-x $$$ y = nest 2 $ x $+$ y
+--------------------------------------------------------------------------------
+--                            Top level API
+--------------------------------------------------------------------------------
 
 -- | Render a syntax tree as a pretty-printable document
 -- (simply showing the resultant doc produces a nice,
@@ -84,26 +121,17 @@ renderPrefixJs = renderPrefixJs' defaultRenderJs
 renderPrefixJs' :: (JsToDoc a, JMacro a) => RenderJs -> a -> Doc
 renderPrefixJs' r = jsToDocR r
 
-braceNest :: Doc -> Doc
-braceNest x = char '{' <+> nest 2 x $$ char '}'
-
--- | Hang with braces:
---
---  hdr {
---    body
---  }
-hangBrace :: Doc -> Doc -> Doc
-hangBrace hdr body = sep [ hdr <> char ' ' <> char '{', nest 2 body, char '}' ]
+--------------------------------------------------------------------------------
+--                            Code Generator
+--------------------------------------------------------------------------------
 
 class JsToDoc a where jsToDocR :: RenderJs -> a -> Doc
-instance JsToDoc JStat where jsToDocR r = renderJsS r r
-instance JsToDoc JExpr where jsToDocR r = renderJsE r r
-instance JsToDoc JVal  where jsToDocR r = renderJsV r r
-instance JsToDoc Ident where jsToDocR r = renderJsI r r
-instance JsToDoc [JExpr] where
-    jsToDocR r = vcat . map ((<> semi) . jsToDocR r)
-instance JsToDoc [JStat] where
-    jsToDocR r = vcat . map ((<> semi) . jsToDocR r)
+instance JsToDoc JStat   where jsToDocR r = renderJsS r r
+instance JsToDoc JExpr   where jsToDocR r = renderJsE r r
+instance JsToDoc JVal    where jsToDocR r = renderJsV r r
+instance JsToDoc Ident   where jsToDocR r = renderJsI r r
+instance JsToDoc [JExpr] where jsToDocR r = vcat . map ((<> semi) . jsToDocR r)
+instance JsToDoc [JStat] where jsToDocR r = vcat . map ((<> semi) . jsToDocR r)
 
 defRenderJsS :: RenderJs -> JStat -> Doc
 defRenderJsS r = \case
@@ -120,12 +148,16 @@ defRenderJsS r = \case
   ContinueStat l      -> maybe (text "continue") (\(LexicalFastString s) -> (text "continue" <+> ftext s)) l
   LabelStat (LexicalFastString l) s -> ftext l <> char ':' $$ printBS s
         where
-          printBS (BlockStat ss) = vcat $ interSemi $ flattenBlocks ss
+          printBS (BlockStat ss) = vcat $ interSemi $ map (jsToDocR r) ss
           printBS x = jsToDocR r x
-          interSemi [x] = [jsToDocR r x]
-          interSemi [] = []
-          interSemi (x:xs) = (jsToDocR r x <> semi) : interSemi xs
 
+  ForStat init p s1 sb -> hangBrace (text "for" <> forCond) (jsToDocR r sb)
+    where
+      forCond = parens $ hcat $ interSemi
+                            [ jsToDocR r init
+                            , jsToDocR r p
+                            , parens (jsToDocR r s1)
+                            ]
   ForInStat each i e b -> hangBrace (text txt <> parens (jsToDocR r i <+> text "in" <+> jsToDocR r e)) (jsToDocR r b)
         where txt | each = "for each"
                   | otherwise = "for"
@@ -134,12 +166,15 @@ defRenderJsS r = \case
               cases = vcat l'
   ReturnStat e      -> text "return" <+> jsToDocR r e
   ApplStat e es     -> jsToDocR r e <> (parens . hsep . punctuate comma $ map (jsToDocR r) es)
+  FuncStat i is b   -> hangBrace (text "function" <+> jsToDocR r i
+                                  <> parens (fsep . punctuate comma . map (jsToDocR r) $ is))
+                             (jsToDocR r b)
   TryStat s i s1 s2 -> hangBrace (text "try") (jsToDocR r s) $$ mbCatch $$ mbFinally
         where mbCatch | s1 == BlockStat [] = PP.empty
                       | otherwise = hangBrace (text "catch" <> parens (jsToDocR r i)) (jsToDocR r s1)
               mbFinally | s2 == BlockStat [] = PP.empty
                         | otherwise = hangBrace (text "finally") (jsToDocR r s2)
-  AssignStat i x    -> case x of
+  AssignStat i op x    -> case x of
     -- special treatment for functions, otherwise there is too much left padding
     -- (more than the length of the expression assigned to). E.g.
     --
@@ -148,19 +183,13 @@ 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
+    ValExpr (JFunc is b) -> sep [jsToDocR r i <+> ftext (aOpText op) <+> text " function" <> parens (hsep . punctuate comma . map (jsToDocR r) $ is) <> char '{', nest 2 (jsToDocR r b), text "}"]
+    _                      -> jsToDocR r i <+> ftext (aOpText op) <+> jsToDocR r x
   UOpStat op x
     | isPre op && isAlphaOp op -> ftext (uOpText op) <+> optParens r x
     | isPre op                 -> ftext (uOpText op) <> optParens r x
     | otherwise                -> optParens r x <> ftext (uOpText op)
-  BlockStat xs -> jsToDocR r (flattenBlocks xs)
-
-flattenBlocks :: [JStat] -> [JStat]
-flattenBlocks = \case
-  BlockStat y:ys -> flattenBlocks y ++ flattenBlocks ys
-  y:ys            -> y : flattenBlocks ys
-  []              -> []
+  BlockStat xs -> jsToDocR r xs
 
 optParens :: RenderJs -> JExpr -> Doc
 optParens r x = case x of
@@ -204,33 +233,12 @@ defRenderJsV r = \case
 defRenderJsI :: RenderJs -> Ident -> Doc
 defRenderJsI _ (TxtI t) = ftext t
 
+aOpText :: AOp -> FastString
+aOpText = \case
+  AssignOp    -> "="
+  AddAssignOp -> "+="
+  SubAssignOp -> "-="
 
-pprStringLit :: FastString -> Doc
-pprStringLit s = hcat [char '\"',encodeJson s, char '\"']
-
-encodeJson :: FastString -> Doc
-encodeJson xs = hcat (map encodeJsonChar (unpackFS xs))
-
-encodeJsonChar :: Char -> Doc
-encodeJsonChar = \case
-  '/'  -> text "\\/"
-  '\b' -> text "\\b"
-  '\f' -> text "\\f"
-  '\n' -> text "\\n"
-  '\r' -> text "\\r"
-  '\t' -> text "\\t"
-  '"'  -> text "\\\""
-  '\\' -> text "\\\\"
-  c
-    | not (isControl c) && ord c <= 127 -> char c
-    | ord c <= 0xff   -> hexxs "\\x" 2 (ord c)
-    | ord c <= 0xffff -> hexxs "\\u" 4 (ord c)
-    | otherwise      -> let cp0 = ord c - 0x10000 -- output surrogate pair
-                        in hexxs "\\u" 4 ((cp0 `shiftR` 10) + 0xd800) <>
-                           hexxs "\\u" 4 ((cp0 .&. 0x3ff) + 0xdc00)
-    where hexxs prefix pad cp =
-            let h = showHex cp ""
-            in  text (prefix ++ replicate (pad - length h) '0' ++ h)
 
 uOpText :: UOp -> FastString
 uOpText = \case
@@ -289,3 +297,56 @@ isAlphaOp = \case
   YieldOp  -> True
   VoidOp   -> True
   _        -> False
+
+pprStringLit :: FastString -> Doc
+pprStringLit s = hcat [char '\"',encodeJson s, char '\"']
+
+--------------------------------------------------------------------------------
+--                            Utilities
+--------------------------------------------------------------------------------
+
+encodeJson :: FastString -> Doc
+encodeJson xs = hcat (map encodeJsonChar (unpackFS xs))
+
+encodeJsonChar :: Char -> Doc
+encodeJsonChar = \case
+  '/'  -> text "\\/"
+  '\b' -> text "\\b"
+  '\f' -> text "\\f"
+  '\n' -> text "\\n"
+  '\r' -> text "\\r"
+  '\t' -> text "\\t"
+  '"'  -> text "\\\""
+  '\\' -> text "\\\\"
+  c
+    | not (isControl c) && ord c <= 127 -> char c
+    | ord c <= 0xff   -> hexxs "\\x" 2 (ord c)
+    | ord c <= 0xffff -> hexxs "\\u" 4 (ord c)
+    | otherwise      -> let cp0 = ord c - 0x10000 -- output surrogate pair
+                        in hexxs "\\u" 4 ((cp0 `shiftR` 10) + 0xd800) <>
+                           hexxs "\\u" 4 ((cp0 .&. 0x3ff) + 0xdc00)
+    where hexxs prefix pad cp =
+            let h = showHex cp ""
+            in  text (prefix ++ replicate (pad - length h) '0' ++ h)
+
+braceNest :: Doc -> Doc
+braceNest x = char '{' <+> nest 2 x $$ char '}'
+
+interSemi :: [Doc] -> [Doc]
+interSemi []     = []
+interSemi [s]    = [s]
+interSemi (x:xs) = x <> text ";" : interSemi xs
+
+addSemi :: Doc -> Doc
+addSemi x = x <> text ";"
+
+-- | Hang with braces:
+--
+--  hdr {
+--    body
+--  }
+hangBrace :: Doc -> Doc -> Doc
+hangBrace hdr body = sep [ hdr <> char ' ' <> char '{', nest 2 body, char '}' ]
+
+($$$) :: Doc -> Doc -> Doc
+x $$$ y = nest 2 $ x $+$ y
diff --git a/compiler/GHC/JS/Syntax.hs b/compiler/GHC/JS/Syntax.hs
index 0b8a6c05b2..b2d381ec7d 100644
--- a/compiler/GHC/JS/Syntax.hs
+++ b/compiler/GHC/JS/Syntax.hs
@@ -58,6 +58,7 @@ module GHC.JS.Syntax
   , JVal(..)
   , Op(..)
   , UOp(..)
+  , AOp(..)
   , Ident(..)
   , JLabel
   -- * pattern synonyms over JS operators
@@ -110,20 +111,22 @@ import GHC.Generics
 -- 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
+  = 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
+  | ForStat    JStat JExpr JStat JStat  -- ^ For
   | 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 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
+  | BlockStat  [JStat]                 -- ^ Blocks
+  | ApplStat   JExpr [JExpr]           -- ^ Application
+  | UOpStat UOp JExpr                  -- ^ Unary operators
+  | AssignStat JExpr AOp JExpr         -- ^ Binding form: @<foo> <op> <bar>@
+  | LabelStat JLabel JStat             -- ^ Statement Labels, makes me nostalgic for qbasic
+  | BreakStat (Maybe JLabel)           -- ^ Break
+  | ContinueStat (Maybe JLabel)        -- ^ Continue
+  | FuncStat   !Ident [Ident] JStat    -- ^ an explicit function definition
   deriving (Eq, Typeable, Generic)
 
 -- | A Label used for 'JStat', specifically 'BreakStat', 'ContinueStat' and of
@@ -146,9 +149,9 @@ 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 , ys          ) -> BlockStat $! xs ++ [ys]
+  (xs           , BlockStat ys) -> BlockStat $! xs : ys
+  (xs           , ys          ) -> BlockStat [xs,ys]
 
 
 --------------------------------------------------------------------------------
@@ -156,13 +159,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..^'
-  | IdxExpr    JExpr JExpr          -- ^ Indexing:  Obj[foo], see 'GHC.JS.Make..!'
-  | InfixExpr  Op JExpr JExpr   -- ^ Infix Expressions, see 'JExpr' pattern synonyms
-  | UOpExpr    UOp JExpr           -- ^ Unary Expressions
+  = 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  Op JExpr JExpr    -- ^ Infix Expressions, see 'JExpr' pattern synonyms
+  | UOpExpr    UOp JExpr         -- ^ Unary Expressions
   | IfExpr     JExpr JExpr JExpr -- ^ If-expression
-  | ApplExpr   JExpr [JExpr]        -- ^ Application
+  | ApplExpr   JExpr [JExpr]     -- ^ Application
   deriving (Eq, Typeable, Generic)
 
 -- * Useful pattern synonyms to ease programming with the deeply embedded JS
@@ -321,6 +324,15 @@ data UOp
 
 instance NFData UOp
 
+-- | JS Unary Operators
+data AOp
+  = AssignOp    -- ^ Vanilla  Assignment: =
+  | AddAssignOp -- ^ Addition Assignment: +=
+  | SubAssignOp -- ^ Subtraction Assignment: -=
+  deriving (Show, Eq, Ord, Enum, Data, Typeable, Generic)
+
+instance NFData AOp
+
 -- | 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
@@ -345,10 +357,12 @@ instance Show SaneDouble where
 --------------------------------------------------------------------------------
 
 jassignAllEqual :: [JExpr] -> [JExpr] -> JStat
-jassignAllEqual xs ys = mconcat (zipWithEqual "assignAllEqual" AssignStat xs ys)
+jassignAllEqual xs ys = mconcat (zipWithEqual "assignAllEqual" go xs ys)
+  where go l r = AssignStat l AssignOp r
 
 jassignAll :: [JExpr] -> [JExpr] -> JStat
-jassignAll xs ys = mconcat (zipWith AssignStat xs ys)
+jassignAll xs ys = mconcat $ zipWith go xs ys
+  where go l r = AssignStat l AssignOp r
 
 jvar :: FastString -> JExpr
 jvar = ValExpr . JVar . TxtI
diff --git a/compiler/GHC/JS/Transform.hs b/compiler/GHC/JS/Transform.hs
index e9c157a97b..9c45ebdd57 100644
--- a/compiler/GHC/JS/Transform.hs
+++ b/compiler/GHC/JS/Transform.hs
@@ -47,6 +47,7 @@ identsS = \case
   Sat.ReturnStat e       -> identsE e
   Sat.IfStat e s1 s2     -> identsE e ++ identsS s1 ++ identsS s2
   Sat.WhileStat _ e s    -> identsE e ++ identsS s
+  Sat.ForStat init p step body -> identsS init ++ identsE p ++ identsS step ++ identsS body
   Sat.ForInStat _ i e s  -> [i] ++ identsE e ++ identsS s
   Sat.SwitchStat e xs s  -> identsE e ++ concatMap traverseCase xs ++ identsS s
                                where traverseCase (e,s) = identsE e ++ identsS s
@@ -54,10 +55,11 @@ identsS = \case
   Sat.BlockStat xs       -> concatMap identsS xs
   Sat.ApplStat e es      -> identsE e ++ concatMap identsE es
   Sat.UOpStat _op e      -> identsE e
-  Sat.AssignStat e1 e2   -> identsE e1 ++ identsE e2
+  Sat.AssignStat e1 _op e2 -> identsE e1 ++ identsE e2
   Sat.LabelStat _l s     -> identsS s
   Sat.BreakStat{}        -> []
   Sat.ContinueStat{}     -> []
+  Sat.FuncStat i args body -> [i] ++ args ++ identsS body
 
 {-# INLINE identsE #-}
 identsE :: Sat.JExpr -> [Ident]
@@ -148,6 +150,8 @@ jmcompos ret app f' v =
            ReturnStat i -> ret ReturnStat `app` f i
            IfStat e s s' -> ret IfStat `app` f e `app` f s `app` f s'
            WhileStat b e s -> ret (WhileStat b) `app` f e `app` f s
+           ForStat init p step body -> ret ForStat  `app` f init `app` f p
+                                           `app` f step `app` f body
            ForInStat b i e s -> ret (ForInStat b) `app` f i `app` f e `app` f s
            SwitchStat e l d -> ret SwitchStat `app` f e `app` l' `app` f d
                where l' = mapM' (\(c,s) -> ret (,) `app` f c `app` f s) l
@@ -158,6 +162,7 @@ jmcompos ret app f' v =
            AssignStat e e' -> ret AssignStat `app` f e `app` f e'
            UnsatBlock _ -> ret v'
            ContinueStat l -> ret (ContinueStat l)
+           FuncStat i args body -> ret FuncStat `app` f i `app` mapM' f args `app` f body
            BreakStat l -> ret (BreakStat l)
            LabelStat l s -> ret (LabelStat l) `app` f s
      JMGExpr v' -> ret JMGExpr `app` case v' of
@@ -217,7 +222,6 @@ jsSaturate_ e = IS $ jfromGADT <$> go (jtoGADT e)
 --------------------------------------------------------------------------------
 --                            Translation
 --
--- This will be moved after GHC.JS.Syntax is removed
 --------------------------------------------------------------------------------
 satJStat :: JStat -> Sat.JStat
 satJStat = witness . proof
@@ -229,6 +233,9 @@ satJStat = witness . proof
         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 (ForStat init p step body) = Sat.ForStat
+                                             (witness init) (satJExpr p)
+                                             (witness step) (witness body)
         witness (ForInStat is_each i iter body) = Sat.ForInStat is_each i
                                                   (satJExpr iter)
                                                   (witness body)
@@ -240,12 +247,13 @@ satJStat = witness . proof
         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 (AssignStat lhs rhs)  = Sat.AssignStat (satJExpr lhs) Sat.AssignOp (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 (FuncStat i args body)  = Sat.FuncStat i args (witness body)
         witness UnsatBlock{}            = error "satJStat: discovered an Unsat...impossibly"
 
 
diff --git a/compiler/GHC/JS/Unsat/Syntax.hs b/compiler/GHC/JS/Unsat/Syntax.hs
index f5ab076aa5..d873caa804 100644
--- a/compiler/GHC/JS/Unsat/Syntax.hs
+++ b/compiler/GHC/JS/Unsat/Syntax.hs
@@ -146,6 +146,7 @@ data JStat
   | ReturnStat JExpr                         -- ^ Return
   | IfStat     JExpr JStat JStat             -- ^ If
   | WhileStat  Bool JExpr JStat              -- ^ While, bool is "do" when True
+  | ForStat    JStat JExpr JStat JStat       -- ^ For
   | ForInStat  Bool Ident JExpr JStat        -- ^ For-in, bool is "each' when True
   | SwitchStat JExpr [(JExpr, JStat)] JStat  -- ^ Switch
   | TryStat    JStat Ident JStat JStat       -- ^ Try
@@ -157,6 +158,7 @@ data JStat
   | LabelStat JsLabel JStat                  -- ^ Statement Labels, makes me nostalgic for qbasic
   | BreakStat (Maybe JsLabel)                -- ^ Break
   | ContinueStat (Maybe JsLabel)             -- ^ Continue
+  | FuncStat   !Ident [Ident] JStat          -- ^ an explicit function definition
   deriving (Eq, Typeable, Generic)
 
 -- | A Label used for 'JStat', specifically 'BreakStat', 'ContinueStat' and of