JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt

This MR changes some simple optimizations and is a first step in re-architecting
the JS backend pipeline to add the optimizer. In particular it:

- removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module
- adds module `GHC.JS.Optimizer`
- defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations
- hooks the optimizer into code gen
- adds FuncStat and ForStat constructors to the backend.

Working Ticket:
- #22736

Related MRs:
- MR !10142
- MR !10000

-------------------------
Metric Decrease:
    CoOpt_Read
    ManyAlternatives
    PmSeriesS
    PmSeriesT
    PmSeriesV
    T10421
    T12707
    T13253
    T13253-spj
    T15164
    T17516
    T18140
    T18282
    T18698a
    T18698b
    T18923
    T1969
    T19695
    T20049
    T3064
    T5321FD
    T5321Fun
    T783
    T9198
    T9233
    T9630
-------------------------

19 files changed, 782 insertions, 395 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
diff --git a/compiler/GHC/StgToJS/Apply.hs b/compiler/GHC/StgToJS/Apply.hs
index 2a4ec9fd17..d960c361df 100644
--- a/compiler/GHC/StgToJS/Apply.hs
+++ b/compiler/GHC/StgToJS/Apply.hs
@@ -408,17 +408,11 @@ mkApplyArr = mconcat
   [ TxtI "h$apply" ||= toJExpr (JList [])
   , TxtI "h$paps"  ||= toJExpr (JList [])
   , ApplStat (var "h$initStatic" .^ "push")
-    [ ValExpr $ JFunc [] $ jVar \i -> mconcat
-        [ i |= zero_
-        , WhileStat False (i .<. Int 65536) $ mconcat
-            [ var "h$apply" .! i |= var "h$ap_gen"
-            , preIncrS i
-            ]
-        , i |= zero_
-        , WhileStat False (i .<. Int 128) $ mconcat
-            [ var "h$paps" .! i |= var "h$pap_gen"
-            , preIncrS i
-            ]
+    [ ValExpr $ JFunc [] $ mconcat
+        [ jFor (|= zero_) (.<. Int 65536) preIncrS
+          (\j -> var "h$apply" .! j |= var "h$ap_gen")
+        , jFor (|= zero_) (.<. Int 128) preIncrS
+          (\j -> var "h$paps" .! j |= var "h$pap_gen")
         , mconcat (map assignSpec applySpec)
         , mconcat (map assignPap specPap)
         ]
diff --git a/compiler/GHC/StgToJS/CodeGen.hs b/compiler/GHC/StgToJS/CodeGen.hs
index fdc431ef4c..6110135afb 100644
--- a/compiler/GHC/StgToJS/CodeGen.hs
+++ b/compiler/GHC/StgToJS/CodeGen.hs
@@ -16,6 +16,7 @@ import GHC.JS.Ppr
 import GHC.JS.Unsat.Syntax
 import GHC.JS.Make
 import GHC.JS.Transform
+import GHC.JS.Optimizer
 
 import GHC.StgToJS.Arg
 import GHC.StgToJS.Sinker
@@ -133,10 +134,10 @@ genUnits m ss spt_entries foreign_stubs = do
         glbl <- State.gets gsGlobal
         staticInit <-
           initStaticPtrs spt_entries
-        let stat = ( -- O.optimize .
-                     satJStat .
-                     jsSaturate (Just $ modulePrefix m 1)
-                   $ mconcat (reverse glbl) <> staticInit)
+        let stat = ( jsOptimize
+                     . satJStat
+                     . jsSaturate (Just $ modulePrefix m 1)
+                     $ mconcat (reverse glbl) <> staticInit)
         let syms = [moduleGlobalSymbol m]
         let oi = ObjUnit
                   { oiSymbols  = syms
@@ -208,7 +209,9 @@ genUnits m ss spt_entries foreign_stubs = do
               _extraTl   <- State.gets (ggsToplevelStats . gsGroup)
               si        <- State.gets (ggsStatic . gsGroup)
               let body = mempty -- mconcat (reverse extraTl) <> b1 ||= e1 <> b2 ||= e2
-              let stat =  satJStat $ jsSaturate (Just $ modulePrefix m n) body
+              let stat =  jsOptimize
+                          . satJStat
+                          $ jsSaturate (Just $ modulePrefix m n) body
               let ids = [bnd]
               syms <- (\(TxtI i) -> [i]) <$> identForId bnd
               let oi = ObjUnit
@@ -245,10 +248,10 @@ genUnits m ss spt_entries foreign_stubs = do
           let allDeps  = collectIds unf decl
               topDeps  = collectTopIds decl
               required = hasExport decl
-              stat     = -- Opt.optimize .
-                         satJStat .
-                         jsSaturate (Just $ modulePrefix m n)
-                       $ mconcat (reverse extraTl) <> tl
+              stat     = jsOptimize
+                         . satJStat
+                         . jsSaturate (Just $ modulePrefix m n)
+                         $ mconcat (reverse extraTl) <> tl
           syms <- mapM (fmap (\(TxtI i) -> i) . identForId) topDeps
           let oi = ObjUnit
                     { oiSymbols  = syms
@@ -308,15 +311,15 @@ genSetConInfo i d l {- srt -} = do
                                 (fixedLayout $ map uTypeVt fields)
                                 (CICon $ dataConTag d)
                                 sr
-  return (ei ||= mkDataEntry)
+  return (mkDataEntry ei)
     where
       -- dataConRepArgTys sometimes returns unboxed tuples. is that a bug?
       fields = concatMap (map primRepToType . typePrimRep . unwrapType . scaledThing)
                          (dataConRepArgTys d)
         -- concatMap (map slotTyToType . repTypeSlots . repType) (dataConRepArgTys d)
 
-mkDataEntry :: JExpr
-mkDataEntry = ValExpr $ JFunc [] returnStack
+mkDataEntry :: Ident -> JStat
+mkDataEntry i = FuncStat i [] returnStack
 
 genToplevelRhs :: Id -> CgStgRhs -> G JStat
 -- general cases:
diff --git a/compiler/GHC/StgToJS/Expr.hs b/compiler/GHC/StgToJS/Expr.hs
index 0b8e34e14b..835140791d 100644
--- a/compiler/GHC/StgToJS/Expr.hs
+++ b/compiler/GHC/StgToJS/Expr.hs
@@ -240,7 +240,7 @@ genEntryLne ctx i rhs@(StgRhsClosure _ext _cc update args body typ) =
   body <- genBody ctx R1 args body typ
   ei@(TxtI eii) <- identForEntryId i
   sr   <- genStaticRefsRhs rhs
-  let f = JFunc [] (bh <> lvs <> body)
+  let f = (bh <> lvs <> body)
   emitClosureInfo $
     ClosureInfo ei
                 (CIRegs 0 $ concatMap idVt args)
@@ -249,7 +249,7 @@ genEntryLne ctx i rhs@(StgRhsClosure _ext _cc update args body typ) =
                     map (stackSlotType . fst) (ctxLneFrameVars ctx))
                 CIStackFrame
                 sr
-  emitToplevel (ei ||= toJExpr f)
+  emitToplevel (jFunction ei [] f)
 genEntryLne ctx i (StgRhsCon cc con _mu _ticks args _typ) = resetSlots $ do
   let payloadSize = ctxLneFrameSize ctx
   ei@(TxtI _eii) <- identForEntryId i
@@ -258,8 +258,7 @@ genEntryLne ctx i (StgRhsCon cc con _mu _ticks args _typ) = resetSlots $ do
   p  <- popLneFrame True payloadSize ctx
   args' <- concatMapM genArg args
   ac    <- allocCon ii con cc args'
-  emitToplevel (ei ||= toJExpr (JFunc []
-    (mconcat [decl ii, p, ac, r1 |= toJExpr ii, returnStack])))
+  emitToplevel (jFunction ei [] (mconcat [decl ii, p, ac, r1 |= toJExpr ii, returnStack]))
 
 -- | Generate the entry function for a local closure
 genEntry :: HasDebugCallStack => ExprCtx -> Id -> CgStgRhs -> G ()
@@ -283,7 +282,7 @@ genEntry ctx i rhs@(StgRhsClosure _ext cc {-_bi live-} upd_flag args body typ) =
                                 (fixedLayout $ map (uTypeVt . idType) live)
                                 et
                                 sr
-  emitToplevel (ei ||= toJExpr (JFunc [] (mconcat [ll, llv, upd, setcc, body])))
+  emitToplevel (jFunction ei [] (mconcat [ll, llv, upd, setcc, body]))
   where
     entryCtx = ctxSetTarget [] (ctxClearLneFrame ctx)
 
@@ -630,7 +629,7 @@ genRet ctx e at as l = freshIdent >>= f
                        ++ if prof then [ObjV] else map stackSlotType lneVars)
                     CIStackFrame
                     sr
-      emitToplevel $ r ||= toJExpr (JFunc [] fun')
+      emitToplevel $ jFunction r [] fun'
       return (pushLne <> saveCCS <> pushRet)
     fst3 ~(x,_,_)  = x
 
diff --git a/compiler/GHC/StgToJS/Linker/Linker.hs b/compiler/GHC/StgToJS/Linker/Linker.hs
index ea8cb79d95..067616b1cb 100644
--- a/compiler/GHC/StgToJS/Linker/Linker.hs
+++ b/compiler/GHC/StgToJS/Linker/Linker.hs
@@ -30,6 +30,7 @@ import Prelude
 import GHC.Platform.Host (hostPlatformArchOS)
 
 import GHC.JS.Make
+import GHC.JS.Optimizer
 import GHC.JS.Unsat.Syntax
 import qualified GHC.JS.Syntax as Sat
 import GHC.JS.Transform
@@ -43,11 +44,11 @@ import GHC.Linker.Static.Utils (exeFileName)
 
 import GHC.StgToJS.Linker.Types
 import GHC.StgToJS.Linker.Utils
+import GHC.StgToJS.Linker.Opt
 import GHC.StgToJS.Rts.Rts
 import GHC.StgToJS.Object
 import GHC.StgToJS.Types hiding (LinkableUnit)
 import GHC.StgToJS.Symbols
-import GHC.StgToJS.Printer
 import GHC.StgToJS.Arg
 import GHC.StgToJS.Closure
 
@@ -332,7 +333,7 @@ renderLinker h mods jsFiles = do
     pure (mod_mod, mod_size)
 
   -- commoned up metadata
-  !meta_length <- fromIntegral <$> putJS (satJStat meta)
+  !meta_length <- fromIntegral <$> putJS (jsOptimize $ satJStat meta)
 
   -- module exports
   mapM_ (putBS . cmc_exports) compacted_mods
diff --git a/compiler/GHC/StgToJS/Linker/Opt.hs b/compiler/GHC/StgToJS/Linker/Opt.hs
new file mode 100644
index 0000000000..867154c61e
--- /dev/null
+++ b/compiler/GHC/StgToJS/Linker/Opt.hs
@@ -0,0 +1,120 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MagicHash #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.StgToJS.Linker.Opt
+-- 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
+--
+-- Optimization pass at link time
+--
+--
+--
+-----------------------------------------------------------------------------
+module GHC.StgToJS.Linker.Opt
+  ( pretty
+  , ghcjsRenderJs
+  )
+where
+
+import GHC.Prelude
+import GHC.Int
+import GHC.Exts
+
+import GHC.JS.Syntax
+import GHC.JS.Ppr
+
+import GHC.Utils.Ppr      as PP
+import GHC.Data.FastString
+import GHC.Types.Unique.Map
+
+import Data.List (sortOn)
+import Data.Char (isAlpha,isDigit,ord)
+import qualified Data.ByteString.Short as SBS
+
+pretty :: JStat -> Doc
+pretty = jsToDocR ghcjsRenderJs
+
+ghcjsRenderJs :: RenderJs
+ghcjsRenderJs = defaultRenderJs
+  { renderJsV = ghcjsRenderJsV
+  , renderJsS = ghcjsRenderJsS
+  , renderJsI = ghcjsRenderJsI
+  }
+
+hdd :: SBS.ShortByteString
+hdd = SBS.pack (map (fromIntegral . ord) "h$$")
+
+ghcjsRenderJsI :: RenderJs -> Ident -> Doc
+ghcjsRenderJsI _ (TxtI fs)
+  -- Fresh symbols are prefixed with "h$$". They aren't explicitly referred by
+  -- name in user code, only in compiled code. Hence we can rename them if we do
+  -- it consistently in all the linked code.
+  --
+  -- These symbols are usually very large because their name includes the
+  -- unit-id, the module name, and some unique number. So we rename these
+  -- symbols with a much shorter globally unique number.
+  --
+  -- Here we reuse their FastString unique for this purpose! Note that it only
+  -- works if we pretty-print all the JS code linked together at once, which we
+  -- currently do. GHCJS used to maintain a CompactorState to support
+  -- incremental linking: it contained the mapping between original symbols and
+  -- their renaming.
+  | hdd `SBS.isPrefixOf` fastStringToShortByteString fs
+  , u <- uniqueOfFS fs
+  = text "h$$" <> hexDoc (fromIntegral u)
+  | otherwise
+  = ftext fs
+
+-- | Render as an hexadecimal number in reversed order (because it's faster and we
+-- don't care about the actual value).
+hexDoc :: Word -> Doc
+hexDoc 0 = char '0'
+hexDoc v = text $ go v
+  where
+    sym (I# i) = C# (indexCharOffAddr# chars i)
+    chars = "0123456789abcdef"#
+    go = \case
+      0 -> []
+      n -> sym (fromIntegral (n .&. 0x0F))
+           : sym (fromIntegral ((n .&. 0xF0) `shiftR` 4))
+           : go (n `shiftR` 8)
+
+
+
+
+-- attempt to resugar some of the common constructs
+ghcjsRenderJsS :: RenderJs -> JStat -> Doc
+ghcjsRenderJsS r s = renderJsS defaultRenderJs r s
+
+-- don't quote keys in our object literals, so closure compiler works
+ghcjsRenderJsV :: RenderJs -> JVal -> Doc
+ghcjsRenderJsV r (JHash m)
+  | isNullUniqMap m = text "{}"
+  | otherwise       = braceNest . PP.fsep . punctuate comma .
+                          map (\(x,y) -> quoteIfRequired x <> PP.colon <+> jsToDocR r y)
+                          -- nonDetEltsUniqMap doesn't introduce non-determinism here because
+                          -- we sort the elements lexically
+                          . sortOn (LexicalFastString . fst) $ nonDetUniqMapToList m
+  where
+    quoteIfRequired :: FastString -> Doc
+    quoteIfRequired x
+      | isUnquotedKey x = ftext x
+      | otherwise       = PP.squotes (ftext x)
+
+    isUnquotedKey :: FastString -> Bool
+    isUnquotedKey fs = case unpackFS fs of
+      []       -> False
+      s@(c:cs) -> all isDigit s || (validFirstIdent c && all validOtherIdent cs)
+
+    validFirstIdent c = c == '_' || c == '$' || isAlpha c
+    validOtherIdent c = isAlpha c || isDigit c
+
+ghcjsRenderJsV r v = renderJsV defaultRenderJs r v
diff --git a/compiler/GHC/StgToJS/Object.hs b/compiler/GHC/StgToJS/Object.hs
index 168784ab81..be87945f3f 100644
--- a/compiler/GHC/StgToJS/Object.hs
+++ b/compiler/GHC/StgToJS/Object.hs
@@ -408,31 +408,35 @@ instance Binary Sat.JStat where
   put_ bh (Sat.ReturnStat e)       = putByte bh 2  >> put_ bh e
   put_ bh (Sat.IfStat e s1 s2)     = putByte bh 3  >> put_ bh e  >> put_ bh s1 >> put_ bh s2
   put_ bh (Sat.WhileStat b e s)    = putByte bh 4  >> put_ bh b  >> put_ bh e  >> put_ bh s
-  put_ bh (Sat.ForInStat b i e s)  = putByte bh 5  >> put_ bh b  >> put_ bh i  >> put_ bh e  >> put_ bh s
-  put_ bh (Sat.SwitchStat e ss s)  = putByte bh 6  >> put_ bh e  >> put_ bh ss >> put_ bh s
-  put_ bh (Sat.TryStat s1 i s2 s3) = putByte bh 7  >> put_ bh s1 >> put_ bh i  >> put_ bh s2 >> put_ bh s3
-  put_ bh (Sat.BlockStat xs)       = putByte bh 8  >> put_ bh xs
-  put_ bh (Sat.ApplStat e es)      = putByte bh 9  >> put_ bh e  >> put_ bh es
-  put_ bh (Sat.UOpStat o e)        = putByte bh 10 >> put_ bh o  >> put_ bh e
-  put_ bh (Sat.AssignStat e1 e2)   = putByte bh 11 >> put_ bh e1 >> put_ bh e2
-  put_ bh (Sat.LabelStat l s)      = putByte bh 12 >> put_ bh l  >> put_ bh s
-  put_ bh (Sat.BreakStat ml)       = putByte bh 13 >> put_ bh ml
-  put_ bh (Sat.ContinueStat ml)    = putByte bh 14 >> put_ bh ml
+  put_ bh (Sat.ForStat is c s bd)  = putByte bh 5 >> put_ bh is  >> put_ bh c >> put_ bh s >> put_ bh bd
+  put_ bh (Sat.ForInStat b i e s)  = putByte bh 6  >> put_ bh b  >> put_ bh i  >> put_ bh e  >> put_ bh s
+  put_ bh (Sat.SwitchStat e ss s)  = putByte bh 7  >> put_ bh e  >> put_ bh ss >> put_ bh s
+  put_ bh (Sat.TryStat s1 i s2 s3) = putByte bh 8  >> put_ bh s1 >> put_ bh i  >> put_ bh s2 >> put_ bh s3
+  put_ bh (Sat.BlockStat xs)       = putByte bh 9  >> put_ bh xs
+  put_ bh (Sat.ApplStat e es)      = putByte bh 10 >> put_ bh e  >> put_ bh es
+  put_ bh (Sat.UOpStat o e)        = putByte bh 11 >> put_ bh o  >> put_ bh e
+  put_ bh (Sat.AssignStat e1 op e2) = putByte bh 12 >> put_ bh e1 >> put_ bh op >> put_ bh e2
+  put_ bh (Sat.LabelStat l s)      = putByte bh 13 >> put_ bh l  >> put_ bh s
+  put_ bh (Sat.BreakStat ml)       = putByte bh 14 >> put_ bh ml
+  put_ bh (Sat.ContinueStat ml)    = putByte bh 15 >> put_ bh ml
+  put_ bh (Sat.FuncStat i is b)    = putByte bh 16 >> put_ bh i >> put_ bh is >> put_ bh b
   get bh = getByte bh >>= \case
     1  -> Sat.DeclStat     <$> get bh <*> get bh
     2  -> Sat.ReturnStat   <$> get bh
     3  -> Sat.IfStat       <$> get bh <*> get bh <*> get bh
     4  -> Sat.WhileStat    <$> get bh <*> get bh <*> get bh
-    5  -> Sat.ForInStat    <$> get bh <*> get bh <*> get bh <*> get bh
-    6  -> Sat.SwitchStat   <$> get bh <*> get bh <*> get bh
-    7  -> Sat.TryStat      <$> get bh <*> get bh <*> get bh <*> get bh
-    8  -> Sat.BlockStat    <$> get bh
-    9  -> Sat.ApplStat     <$> get bh <*> get bh
-    10 -> Sat.UOpStat      <$> get bh <*> get bh
-    11 -> Sat.AssignStat   <$> get bh <*> get bh
-    12 -> Sat.LabelStat    <$> get bh <*> get bh
-    13 -> Sat.BreakStat    <$> get bh
-    14 -> Sat.ContinueStat <$> get bh
+    5  -> Sat.ForStat      <$> get bh <*> get bh <*> get bh <*> get bh
+    6  -> Sat.ForInStat    <$> get bh <*> get bh <*> get bh <*> get bh
+    7  -> Sat.SwitchStat   <$> get bh <*> get bh <*> get bh
+    8  -> Sat.TryStat      <$> get bh <*> get bh <*> get bh <*> get bh
+    9  -> Sat.BlockStat    <$> get bh
+    10 -> Sat.ApplStat     <$> get bh <*> get bh
+    11 -> Sat.UOpStat      <$> get bh <*> get bh
+    12 -> Sat.AssignStat   <$> get bh <*> get bh <*> get bh
+    13 -> Sat.LabelStat    <$> get bh <*> get bh
+    14 -> Sat.BreakStat    <$> get bh
+    15 -> Sat.ContinueStat <$> get bh
+    16 -> Sat.FuncStat     <$> get bh <*> get bh <*> get bh
     n -> error ("Binary get bh JStat: invalid tag: " ++ show n)
 
 
@@ -541,6 +545,10 @@ instance Binary Sat.UOp where
   put_ bh = putEnum bh
   get bh = getEnum bh
 
+instance Binary Sat.AOp where
+  put_ bh = putEnum bh
+  get bh = getEnum bh
+
 -- 16 bit sizes should be enough...
 instance Binary CILayout where
   put_ bh CILayoutVariable           = putByte bh 1
diff --git a/compiler/GHC/StgToJS/Printer.hs b/compiler/GHC/StgToJS/Printer.hs
deleted file mode 100644
index 03d224f0f9..0000000000
--- a/compiler/GHC/StgToJS/Printer.hs
+++ /dev/null
@@ -1,216 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MagicHash #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  GHC.StgToJS.Printer
--- 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
---
--- Custom prettyprinter for JS AST uses the JS PPr module for most of
--- the work
---
---
------------------------------------------------------------------------------
-module GHC.StgToJS.Printer
-  ( pretty
-  , ghcjsRenderJs
-  , prettyBlock
-  )
-where
-
-import GHC.Prelude
-import GHC.Int
-import GHC.Exts
-
-import GHC.JS.Syntax
-import GHC.JS.Ppr
-
-import GHC.Utils.Ppr      as PP
-import GHC.Data.FastString
-import GHC.Types.Unique.Map
-
-import Data.List (sortOn)
-import Data.Char (isAlpha,isDigit,ord)
-import qualified Data.ByteString.Short as SBS
-
-pretty :: JStat -> Doc
-pretty = jsToDocR ghcjsRenderJs
-
-ghcjsRenderJs :: RenderJs
-ghcjsRenderJs = defaultRenderJs
-  { renderJsV = ghcjsRenderJsV
-  , renderJsS = ghcjsRenderJsS
-  , renderJsI = ghcjsRenderJsI
-  }
-
-hdd :: SBS.ShortByteString
-hdd = SBS.pack (map (fromIntegral . ord) "h$$")
-
-ghcjsRenderJsI :: RenderJs -> Ident -> Doc
-ghcjsRenderJsI _ (TxtI fs)
-  -- Fresh symbols are prefixed with "h$$". They aren't explicitly referred by
-  -- name in user code, only in compiled code. Hence we can rename them if we do
-  -- it consistently in all the linked code.
-  --
-  -- These symbols are usually very large because their name includes the
-  -- unit-id, the module name, and some unique number. So we rename these
-  -- symbols with a much shorter globally unique number.
-  --
-  -- Here we reuse their FastString unique for this purpose! Note that it only
-  -- works if we pretty-print all the JS code linked together at once, which we
-  -- currently do. GHCJS used to maintain a CompactorState to support
-  -- incremental linking: it contained the mapping between original symbols and
-  -- their renaming.
-  | hdd `SBS.isPrefixOf` fastStringToShortByteString fs
-  , u <- uniqueOfFS fs
-  = text "h$$" <> hexDoc (fromIntegral u)
-  | otherwise
-  = ftext fs
-
--- | Render as an hexadecimal number in reversed order (because it's faster and we
--- don't care about the actual value).
-hexDoc :: Word -> Doc
-hexDoc 0 = char '0'
-hexDoc v = text $ go v
-  where
-    sym (I# i) = C# (indexCharOffAddr# chars i)
-    chars = "0123456789abcdef"#
-    go = \case
-      0 -> []
-      n -> sym (fromIntegral (n .&. 0x0F))
-           : sym (fromIntegral ((n .&. 0xF0) `shiftR` 4))
-           : go (n `shiftR` 8)
-
-
-
-
--- attempt to resugar some of the common constructs
-ghcjsRenderJsS :: RenderJs -> JStat -> Doc
-ghcjsRenderJsS r (BlockStat xs) = prettyBlock r (flattenBlocks xs)
-ghcjsRenderJsS r s               = renderJsS defaultRenderJs r s
-
--- don't quote keys in our object literals, so closure compiler works
-ghcjsRenderJsV :: RenderJs -> JVal -> Doc
-ghcjsRenderJsV r (JHash m)
-  | isNullUniqMap m = text "{}"
-  | otherwise       = braceNest . PP.fsep . punctuate comma .
-                          map (\(x,y) -> quoteIfRequired x <> PP.colon <+> jsToDocR r y)
-                          -- nonDetEltsUniqMap doesn't introduce non-determinism here because
-                          -- we sort the elements lexically
-                          . sortOn (LexicalFastString . fst) $ nonDetUniqMapToList m
-  where
-    quoteIfRequired :: FastString -> Doc
-    quoteIfRequired x
-      | isUnquotedKey x = ftext x
-      | otherwise       = PP.squotes (ftext x)
-
-    isUnquotedKey :: FastString -> Bool
-    isUnquotedKey fs = case unpackFS fs of
-      []       -> False
-      s@(c:cs) -> all isDigit s || (validFirstIdent c && all validOtherIdent cs)
-
-    validFirstIdent c = c == '_' || c == '$' || isAlpha c
-    validOtherIdent c = isAlpha c || isDigit c
-
-ghcjsRenderJsV r v = renderJsV defaultRenderJs r v
-
-prettyBlock :: RenderJs -> [JStat] -> Doc
-prettyBlock r xs = vcat $ map addSemi (prettyBlock' r xs)
-
--- recognize common patterns in a block and convert them to more idiomatic/concise javascript
-prettyBlock' :: RenderJs -> [JStat] -> [Doc]
--- return/...
-prettyBlock' r ( x@(ReturnStat _)
-               : xs
-               )
-      | not (null xs)
-      = prettyBlock' r [x]
--- declare/assign
-prettyBlock' r ( (DeclStat i Nothing)
-               : (AssignStat (ValExpr (JVar i')) v)
-               : xs
-               )
-      | i == i'
-      = prettyBlock' r (DeclStat i (Just v) : xs)
-
--- resugar for loops with/without var declaration
-prettyBlock' r ( (DeclStat i (Just v0))
-               : (WhileStat False p (BlockStat bs))
-               : xs
-               )
-     | not (null flat) && isForUpdStat (last flat)
-     = mkFor r True i v0 p (last flat) (init flat) : prettyBlock' r xs
-        where
-          flat = flattenBlocks bs
-prettyBlock' r ( (AssignStat (ValExpr (JVar i)) v0)
-               : (WhileStat False p (BlockStat bs))
-               : xs
-               )
-     | not (null flat) && isForUpdStat (last flat)
-     = mkFor r False i v0 p (last flat) (init flat) : prettyBlock' r xs
-        where
-          flat = flattenBlocks bs
-
--- global function (does not preserve semantics but works for GHCJS)
-prettyBlock' r ( (DeclStat i (Just (ValExpr (JFunc is b))))
-               : xs
-               )
-      = (hangBrace (text "function" <+> jsToDocR r i <> parens (fsep . punctuate comma . map (jsToDocR r) $ is))
-                             (jsToDocR r b)
-                  ) : prettyBlock' r xs
--- modify/assign operators
-prettyBlock' r ( (AssignStat (ValExpr (JVar i)) (InfixExpr AddOp (ValExpr (JVar i')) (ValExpr (JInt 1))))
-               : xs
-               )
-      | i == i' = (text "++" <> jsToDocR r i) : prettyBlock' r xs
-prettyBlock' r ( (AssignStat (ValExpr (JVar i)) (InfixExpr SubOp (ValExpr (JVar i')) (ValExpr (JInt 1))))
-               : xs
-               )
-      | i == i' = (text "--" <> jsToDocR r i) : prettyBlock' r xs
-prettyBlock' r ( (AssignStat (ValExpr (JVar i)) (InfixExpr AddOp (ValExpr (JVar i')) e))
-               : xs
-               )
-      | i == i' = (jsToDocR r i <+> text "+=" <+> jsToDocR r e) : prettyBlock' r xs
-prettyBlock' r ( (AssignStat (ValExpr (JVar i)) (InfixExpr SubOp (ValExpr (JVar i')) e))
-               : xs
-               )
-      | i == i' = (jsToDocR r i <+> text "-=" <+> jsToDocR r e) : prettyBlock' r xs
-
-
-prettyBlock' r (x:xs) = jsToDocR r x : prettyBlock' r xs
-prettyBlock' _ [] = []
-
--- build the for block
-mkFor :: RenderJs -> Bool -> Ident -> JExpr -> JExpr -> JStat -> [JStat] -> Doc
-mkFor r decl i v0 p s1 sb = hangBrace (text "for" <> forCond)
-                                      (jsToDocR r $ BlockStat sb)
-    where
-      c0 | decl      = text "var" <+> jsToDocR r i <+> char '=' <+> jsToDocR r v0
-         | otherwise =                jsToDocR r i <+> char '=' <+> jsToDocR r v0
-      forCond = parens $ hcat $ interSemi
-                            [ c0
-                            , jsToDocR r p
-                            , parens (jsToDocR r s1)
-                            ]
-
--- check if a statement is suitable to be converted to something in the for(;;x) position
-isForUpdStat :: JStat -> Bool
-isForUpdStat UOpStat {}    = True
-isForUpdStat AssignStat {} = True
-isForUpdStat ApplStat {}   = True
-isForUpdStat _             = False
-
-interSemi :: [Doc] -> [Doc]
-interSemi [] = [PP.empty]
-interSemi [s] = [s]
-interSemi (x:xs) = x <> text ";" : interSemi xs
-
-addSemi :: Doc -> Doc
-addSemi x = x <> text ";"
diff --git a/compiler/GHC/StgToJS/Rts/Rts.hs b/compiler/GHC/StgToJS/Rts/Rts.hs
index 2f41862b6a..a25cd6c4e7 100644
--- a/compiler/GHC/StgToJS/Rts/Rts.hs
+++ b/compiler/GHC/StgToJS/Rts/Rts.hs
@@ -30,16 +30,18 @@ import GHC.Prelude
 import GHC.JS.Unsat.Syntax
 import GHC.JS.Make
 import GHC.JS.Transform
+import GHC.JS.Optimizer
 
 import GHC.StgToJS.Apply
 import GHC.StgToJS.Closure
 import GHC.StgToJS.Heap
-import GHC.StgToJS.Printer
 import GHC.StgToJS.Profiling
 import GHC.StgToJS.Regs
 import GHC.StgToJS.Types
 import GHC.StgToJS.Stack
 
+import GHC.StgToJS.Linker.Opt
+
 import GHC.Data.FastString
 import GHC.Types.Unique.Map
 
@@ -134,7 +136,7 @@ closureConstructors s = BlockStat
            | otherwise = mempty
 
     mkClosureCon :: Maybe Int -> JStat
-    mkClosureCon n0 = funName ||= toJExpr fun
+    mkClosureCon n0 = jFunction funName args funBod
       where
         n | Just n' <- n0 = n'
           | Nothing <- n0 = 0
@@ -142,7 +144,6 @@ closureConstructors s = BlockStat
                 | Nothing <- n0 = TxtI $ mkFastString "h$c"
         -- args are: f x1 x2 .. xn [cc]
         args   = TxtI "f" : addCCArg' (map varName [1..n])
-        fun    = JFunc args funBod
         -- x1 goes into closureField1. All the other args are bundled into an
         -- object in closureField2: { d1 = x2, d2 = x3, ... }
         --
@@ -157,12 +158,12 @@ closureConstructors s = BlockStat
             ]
 
     mkDataFill :: Int -> JStat
-    mkDataFill n = funName ||= toJExpr fun
+    mkDataFill n = jFunction funName (map TxtI ds) body
       where
         funName    = TxtI $ dataName n
         ds         = map dataFieldName [1..n]
         extra_args = ValExpr . JHash . listToUniqMap . zip ds $ map (toJExpr . TxtI) ds
-        fun        = JFunc (map TxtI ds) (checkD <> returnS extra_args)
+        body       = (checkD <> returnS extra_args)
 
 -- | JS Payload to perform stack manipulation in the RTS
 stackManip :: JStat
@@ -172,10 +173,10 @@ stackManip = mconcat (map mkPush [1..32]) <>
     mkPush :: Int -> JStat
     mkPush n = let funName = TxtI $ mkFastString ("h$p" ++ show n)
                    as      = map varName [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
+                   body    = ((sp |= sp + toJExpr n)
+                               <> mconcat (zipWith (\i a -> stack .! (sp - toJExpr (n-i)) |= toJExpr a)
+                                            [1..] as))
+               in jFunction funName as body
 
     -- partial pushes, based on bitmap, increases Sp by highest bit
     mkPpush :: Integer -> JStat
@@ -185,11 +186,10 @@ stackManip = mconcat (map mkPush [1..32]) <>
                       n       = length bits
                       h       = last bits
                       args    = map varName [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
+                      body    = mconcat [ sp |= sp + toJExpr (h+1)
+                                        , mconcat (zipWith (\b a -> stack .! (sp - toJExpr (h-b)) |= toJExpr a) bits args)
+                                        ]
+                   in jFunction funName args body
 
 bitsIdx :: Integer -> [Int]
 bitsIdx n | n < 0 = error "bitsIdx: negative"
@@ -244,12 +244,12 @@ loadRegs :: JStat
 loadRegs = mconcat $ map mkLoad [1..32]
   where
     mkLoad :: Int -> JStat
-    mkLoad n = let args   = map varName [1..n]
-                   assign = zipWith (\a r -> toJExpr r |= toJExpr a)
-                              args (reverse $ take n regsFromR1)
-                   fname  = TxtI $ mkFastString ("h$l" ++ show n)
-                   fun    = JFunc args (mconcat assign)
-               in fname ||= toJExpr fun
+    mkLoad n = let args  = map varName [1..n]
+                   body  = mconcat $
+                           zipWith (\a r -> toJExpr r |= toJExpr a)
+                           args (reverse $ take n regsFromR1)
+                   fname = TxtI $ mkFastString ("h$l" ++ show n)
+               in jFunction fname args body
 
 -- | Assign registers R1 ... Rn in descending order, that is assign Rn first.
 -- This function uses the 'assignRegs'' array to construct functions which set
@@ -314,11 +314,11 @@ rtsDecls = jsSaturate (Just "h$RTSD") $
 
 -- | print the embedded RTS to a String
 rtsText :: StgToJSConfig -> String
-rtsText = show . pretty . satJStat . rts
+rtsText = show . pretty . jsOptimize . satJStat . rts
 
 -- | print the RTS declarations to a String.
 rtsDeclsText :: String
-rtsDeclsText = show . pretty . satJStat $ rtsDecls
+rtsDeclsText = show . pretty . jsOptimize . satJStat $ rtsDecls
 
 -- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform'
 rts :: StgToJSConfig -> JStat
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index a0a5f23133..fc2151f547 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -532,6 +532,7 @@ Library
         GHC.IfaceToCore
         GHC.Iface.Type
         GHC.JS.Make
+        GHC.JS.Optimizer
         GHC.JS.Ppr
         GHC.JS.Syntax
         GHC.JS.Transform
@@ -672,7 +673,6 @@ Library
         GHC.StgToJS.Object
         GHC.StgToJS.Prim
         GHC.StgToJS.Profiling
-        GHC.StgToJS.Printer
         GHC.StgToJS.Regs
         GHC.StgToJS.Rts.Types
         GHC.StgToJS.Rts.Rts
@@ -686,6 +686,7 @@ Library
         GHC.StgToJS.Linker.Linker
         GHC.StgToJS.Linker.Types
         GHC.StgToJS.Linker.Utils
+        GHC.StgToJS.Linker.Opt
         GHC.Stg.Unarise
         GHC.SysTools
         GHC.SysTools.Ar
diff --git a/testsuite/tests/javascript/opt/all.T b/testsuite/tests/javascript/opt/all.T
new file mode 100644
index 0000000000..35bdb51ee2
--- /dev/null
+++ b/testsuite/tests/javascript/opt/all.T
@@ -0,0 +1,4 @@
+# These are JavaScript-specific tests for the JS backend optimizer
+setTestOpts(when(not(js_arch()),skip))
+
+test('deadCodeElim', normal, compile_and_run, ['-package ghc'])
diff --git a/testsuite/tests/javascript/opt/deadCodeElim.hs b/testsuite/tests/javascript/opt/deadCodeElim.hs
new file mode 100644
index 0000000000..70f6aa6a74
--- /dev/null
+++ b/testsuite/tests/javascript/opt/deadCodeElim.hs
@@ -0,0 +1,96 @@
+
+import GHC.JS.Optimizer
+import GHC.JS.Syntax
+import GHC.JS.Unsat.Syntax (Ident (..))
+
+import GHC.Data.FastString
+
+double_return :: JStat
+double_return = BlockStat [ ReturnStat (SatInt 0)
+                          , ReturnStat (SatInt 1)
+                          ]
+
+double_return_opt :: JStat
+double_return_opt = (BlockStat [ReturnStat (SatInt 0)])
+
+in_func :: JStat
+in_func = AssignStat (jvar (fsLit "foo")) AssignOp (ValExpr (JFunc [] double_return))
+
+in_func_opt :: JStat
+in_func_opt = AssignStat (jvar (fsLit "foo")) AssignOp (ValExpr (JFunc [] double_return_opt))
+
+nested_blocks :: JStat
+nested_blocks = BlockStat [ double_return <> double_return
+                          , double_return
+                          ] <> double_return
+
+nested_blocks_opt :: JStat
+nested_blocks_opt = double_return_opt
+
+global_func :: JStat
+global_func = FuncStat (TxtI (fsLit "bar")) [] double_return
+
+global_func_opt :: JStat
+global_func_opt = FuncStat (TxtI (fsLit "bar")) [] double_return_opt
+
+func_with_locals :: JStat
+func_with_locals = AssignStat (jvar (fsLit "foo"))
+                   AssignOp
+                   (ValExpr (JFunc []
+                            (BlockStat [ AssignStat (jvar (fsLit "one")) AssignOp (SatInt 2)
+                                       , AssignStat (jvar (fsLit "two")) AssignOp (SatInt 3)
+                                       , ApplStat (jvar (fsLit "f")) [(SatInt 100)]
+                                       , ReturnStat (SatInt 0)
+                                       , ReturnStat (SatInt 1)
+                                       ])))
+
+func_with_locals_opt :: JStat
+func_with_locals_opt = AssignStat (jvar (fsLit "foo"))
+                       AssignOp
+                       (ValExpr (JFunc []
+                                 (BlockStat [ AssignStat (jvar (fsLit "one")) AssignOp (SatInt 2)
+                                            , AssignStat (jvar (fsLit "two")) AssignOp (SatInt 3)
+                                            , ApplStat (jvar (fsLit "f")) [(SatInt 100)]
+                                            , ReturnStat (SatInt 0)
+                                            ])))
+
+-- This one comes straight from MR10260 where we noticed the optimizer was not catching the redundant return
+bignum_test :: JStat
+bignum_test = DeclStat (TxtI $ fsLit "h$ghczmbignumZCGHCziNumziIntegerziintegerToInt64zh_e")
+              (Just (ValExpr $ JFunc [] $ BlockStat [ DeclStat (TxtI $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e") (Just (jvar $ fsLit "h$r2"))
+                                                    , ApplStat (jvar $ fsLit "h$p1") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziInteger_99"]
+                                                    , ReturnStat (ApplExpr (jvar $ fsLit "h$e") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e"])
+                                                    , ReturnStat (ApplExpr (jvar $ fsLit "h$rs") [])]))
+
+bignum_test_opt :: JStat
+bignum_test_opt =
+  DeclStat (TxtI $ fsLit "h$ghczmbignumZCGHCziNumziIntegerziintegerToInt64zh_e")
+              (Just (ValExpr $ JFunc [] $ BlockStat [ DeclStat (TxtI $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e") (Just (jvar $ fsLit "h$r2"))
+                                                    , ApplStat (jvar $ fsLit "h$p1") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziInteger_99"]
+                                                    , ReturnStat (ApplExpr (jvar $ fsLit "h$e") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e"])
+                                                    ]))
+
+bignum_test_2 :: JStat
+bignum_test_2 = BlockStat [FuncStat (TxtI $ fsLit "h$$ghczmbignumZCGHCziNumziInteger_99") [] (BlockStat [DeclStat (TxtI $ fsLit "h$ghczmbignumZCGHCziNumziIntegerziintegerToInt64zh_e")
+              (Just (ValExpr $ JFunc [] $ BlockStat [ DeclStat (TxtI $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e") (Just (jvar $ fsLit "h$r2"))
+                                                    , ApplStat (jvar $ fsLit "h$p1") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziInteger_99"]
+                                                    , ReturnStat (ApplExpr (jvar $ fsLit "h$e") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e"])
+                                                    , ReturnStat (ApplExpr (jvar $ fsLit "h$rs") [])]))])]
+
+bignum_test_opt_2 :: JStat
+bignum_test_opt_2 = BlockStat [FuncStat (TxtI $ fsLit "h$$ghczmbignumZCGHCziNumziInteger_99") [] (BlockStat [DeclStat (TxtI $ fsLit "h$ghczmbignumZCGHCziNumziIntegerziintegerToInt64zh_e")
+              (Just (ValExpr $ JFunc [] $ BlockStat [ DeclStat (TxtI $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e") (Just (jvar $ fsLit "h$r2"))
+                                                    , ApplStat (jvar $ fsLit "h$p1") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziInteger_99"]
+                                                    , ReturnStat (ApplExpr (jvar $ fsLit "h$e") [jvar $ fsLit "h$$ghczmbignumZCGHCziNumziIntegerzids_s_2f9e"])
+                                                    ]))])]
+
+main :: IO ()
+main = mapM_ print
+       [ jsOptimize double_return == double_return_opt
+       , jsOptimize in_func       == in_func_opt
+       , jsOptimize nested_blocks == nested_blocks_opt
+       , jsOptimize global_func   == global_func_opt
+       , jsOptimize func_with_locals == func_with_locals_opt
+       , jsOptimize bignum_test == bignum_test_opt
+       , jsOptimize bignum_test_2 == bignum_test_opt_2
+       ]
diff --git a/testsuite/tests/javascript/opt/deadCodeElim.stdout b/testsuite/tests/javascript/opt/deadCodeElim.stdout
new file mode 100644
index 0000000000..672e08f95c
--- /dev/null
+++ b/testsuite/tests/javascript/opt/deadCodeElim.stdout
@@ -0,0 +1,7 @@
+True
+True
+True
+True
+True
+True
+True
diff --git a/testsuite/tests/linters/notes.stdout b/testsuite/tests/linters/notes.stdout
index 51fef76584..aed259caf9 100644
--- a/testsuite/tests/linters/notes.stdout
+++ b/testsuite/tests/linters/notes.stdout
@@ -7,7 +7,7 @@ ref    compiler/GHC/Core/Opt/Simplify/Utils.hs:1343:37:     Note [Gentle mode]
 ref    compiler/GHC/Core/Opt/Specialise.hs:1790:28:     Note [Arity decrease]
 ref    compiler/GHC/Core/TyCo/Rep.hs:1556:31:     Note [What prevents a constraint from floating]
 ref    compiler/GHC/Driver/Main.hs:1762:34:     Note [simpleTidyPgm - mkBootModDetailsTc]
-ref    compiler/GHC/Driver/Session.hs:3993:49:     Note [Eta-reduction in -O0]
+ref    compiler/GHC/Driver/Session.hs:4062:49:     Note [Eta-reduction in -O0]
 ref    compiler/GHC/Hs/Expr.hs:194:63:     Note [Pending Splices]
 ref    compiler/GHC/Hs/Expr.hs:1736:87:     Note [Lifecycle of a splice]
 ref    compiler/GHC/Hs/Expr.hs:1772:7:     Note [Pending Splices]
@@ -15,6 +15,7 @@ ref    compiler/GHC/Hs/Extension.hs:146:5:     Note [Strict argument type constr
 ref    compiler/GHC/Hs/Pat.hs:143:74:     Note [Lifecycle of a splice]
 ref    compiler/GHC/HsToCore/Pmc/Solver.hs:858:20:     Note [COMPLETE sets on data families]
 ref    compiler/GHC/HsToCore/Quote.hs:1476:7:     Note [How brackets and nested splices are handled]
+ref    compiler/GHC/JS/Optimizer.hs:206:7:     Note [Unsafe JavaScript optimizations]
 ref    compiler/GHC/Stg/Unarise.hs:442:32:     Note [Renaming during unarisation]
 ref    compiler/GHC/StgToCmm.hs:106:18:     Note [codegen-split-init]
 ref    compiler/GHC/StgToCmm.hs:109:18:     Note [pipeline-split-init]
@@ -25,14 +26,14 @@ ref    compiler/GHC/Tc/Gen/HsType.hs:2621:7:     Note [Matching a kind signature
 ref    compiler/GHC/Tc/Gen/Pat.hs:176:20:     Note [Typing patterns in pattern bindings]
 ref    compiler/GHC/Tc/Gen/Pat.hs:1127:7:     Note [Matching polytyped patterns]
 ref    compiler/GHC/Tc/Gen/Sig.hs:81:10:     Note [Overview of type signatures]
-ref    compiler/GHC/Tc/Gen/Splice.hs:357:16:     Note [How brackets and nested splices are handled]
-ref    compiler/GHC/Tc/Gen/Splice.hs:532:35:     Note [PendingRnSplice]
-ref    compiler/GHC/Tc/Gen/Splice.hs:656:7:     Note [How brackets and nested splices are handled]
-ref    compiler/GHC/Tc/Gen/Splice.hs:889:11:     Note [How brackets and nested splices are handled]
+ref    compiler/GHC/Tc/Gen/Splice.hs:356:16:     Note [How brackets and nested splices are handled]
+ref    compiler/GHC/Tc/Gen/Splice.hs:531:35:     Note [PendingRnSplice]
+ref    compiler/GHC/Tc/Gen/Splice.hs:655:7:     Note [How brackets and nested splices are handled]
+ref    compiler/GHC/Tc/Gen/Splice.hs:888:11:     Note [How brackets and nested splices are handled]
 ref    compiler/GHC/Tc/Instance/Family.hs:474:35:     Note [Constrained family instances]
 ref    compiler/GHC/Tc/Module.hs:711:15:     Note [Extra dependencies from .hs-boot files]
 ref    compiler/GHC/Tc/Solver/Rewrite.hs:1008:7:     Note [Stability of rewriting]
-ref    compiler/GHC/Tc/TyCl.hs:1120:6:     Note [Unification variables need fresh Names]
+ref    compiler/GHC/Tc/TyCl.hs:1124:6:     Note [Unification variables need fresh Names]
 ref    compiler/GHC/Tc/Types.hs:692:33:     Note [Extra dependencies from .hs-boot files]
 ref    compiler/GHC/Tc/Types.hs:1423:47:     Note [Care with plugin imports]
 ref    compiler/GHC/Tc/Types/Constraint.hs:255:34:     Note [NonCanonical Semantics]
@@ -46,8 +47,8 @@ ref    hadrian/src/Expression.hs:145:30:     Note [Linking ghc-bin against threa
 ref    linters/lint-notes/Notes.hs:32:29:     Note [" <> T.unpack x <> "]
 ref    linters/lint-notes/Notes.hs:69:22:     Note [...]
 ref    testsuite/config/ghc:272:10:     Note [WayFlags]
-ref    testsuite/driver/testlib.py:160:10:     Note [Why is there no stage1 setup function?]
-ref    testsuite/driver/testlib.py:164:2:     Note [Why is there no stage1 setup function?]
+ref    testsuite/driver/testlib.py:165:10:     Note [Why is there no stage1 setup function?]
+ref    testsuite/driver/testlib.py:169:2:     Note [Why is there no stage1 setup function?]
 ref    testsuite/mk/boilerplate.mk:267:2:     Note [WayFlags]
 ref    testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.hs:30:27:     Note [Extra TcS Untouchables]
 ref    testsuite/tests/perf/should_run/all.T:8:6:     Note [Solving from instances when interacting Dicts]