{-# LANGUAGE LambdaCase, OverloadedStrings #-}

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

import qualified GHC.JS.Opt.Simple as Simple

{-
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 :: JStat -> JStat
jsOptimize JStat
s0 = JStat -> JStat
jsOptimizeStat (JStat -> JStat
Simple.simpleOpt JStat
s0)

jsOptimizeStat :: JStat -> JStat
jsOptimizeStat :: JStat -> JStat
jsOptimizeStat JStat
s0 = JStat -> JStat
go JStat
s0
  where
    p_opt :: JStat -> JStat
p_opt = JStat -> JStat
jsOptimizeStat
    opt :: [JStat] -> [JStat]
opt   = [JStat] -> [JStat]
jsOptimize'
    e_opt :: JExpr -> JExpr
e_opt = JExpr -> JExpr
jExprOptimize
    -- base case
    go :: JStat -> JStat
go (BlockStat [JStat]
xs) = [JStat] -> JStat
BlockStat ([JStat] -> [JStat]
opt [JStat]
xs)
    -- recursive cases
    go (ForStat JStat
i JExpr
p JStat
s JStat
body)   = JStat -> JExpr -> JStat -> JStat -> JStat
ForStat (JStat -> JStat
go JStat
i) (JExpr -> JExpr
e_opt JExpr
p) (JStat -> JStat
go JStat
s) (JStat -> JStat
p_opt JStat
body)
    go (ForInStat Bool
b Ident
i JExpr
p JStat
body) = Bool -> Ident -> JExpr -> JStat -> JStat
ForInStat Bool
b Ident
i JExpr
p (JStat -> JStat
p_opt JStat
body)
    go (WhileStat Bool
b JExpr
c JStat
body)   = Bool -> JExpr -> JStat -> JStat
WhileStat Bool
b (JExpr -> JExpr
e_opt JExpr
c) (JStat -> JStat
p_opt JStat
body)
    go (SwitchStat JExpr
s [(JExpr, JStat)]
ps JStat
body) = JExpr -> [(JExpr, JStat)] -> JStat -> JStat
SwitchStat JExpr
s (((JExpr, JStat) -> (JExpr, JStat))
-> [(JExpr, JStat)] -> [(JExpr, JStat)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((JStat -> JStat) -> (JExpr, JStat) -> (JExpr, JStat)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second JStat -> JStat
go) [(JExpr, JStat)]
ps) (JStat -> JStat
p_opt JStat
body)
    go (FuncStat Ident
i [Ident]
args JStat
body) = Ident -> [Ident] -> JStat -> JStat
FuncStat Ident
i [Ident]
args (JStat -> JStat
p_opt JStat
body)
    go (IfStat JExpr
c JStat
t JStat
e)         = JExpr -> JStat -> JStat -> JStat
IfStat (JExpr -> JExpr
e_opt JExpr
c) (JStat -> JStat
p_opt JStat
t) (JStat -> JStat
p_opt JStat
e)
    go (TryStat JStat
ths Ident
i JStat
c JStat
f)    = JStat -> Ident -> JStat -> JStat -> JStat
TryStat (JStat -> JStat
p_opt JStat
ths) Ident
i (JStat -> JStat
p_opt JStat
c) (JStat -> JStat
p_opt JStat
f)
    go (LabelStat JLabel
lbl JStat
s)      = JLabel -> JStat -> JStat
LabelStat JLabel
lbl (JStat -> JStat
p_opt JStat
s)
    -- special case: drive the optimizer into expressions
    go (AssignStat JExpr
id AOp
op JExpr
rhs) = JExpr -> AOp -> JExpr -> JStat
AssignStat (JExpr -> JExpr
e_opt JExpr
id) AOp
op (JExpr -> JExpr
e_opt JExpr
rhs)
    go (DeclStat Ident
i (Just JExpr
e))  = Ident -> Maybe JExpr -> JStat
DeclStat Ident
i (JExpr -> Maybe JExpr
forall a. a -> Maybe a
Just (JExpr -> Maybe JExpr) -> JExpr -> Maybe JExpr
forall a b. (a -> b) -> a -> b
$ JExpr -> JExpr
e_opt JExpr
e)
    go (ReturnStat JExpr
e)         = JExpr -> JStat
ReturnStat (JExpr -> JExpr
e_opt JExpr
e)
    go (UOpStat UOp
op JExpr
e)         = UOp -> JExpr -> JStat
UOpStat UOp
op (JExpr -> JExpr
e_opt JExpr
e)
    go (ApplStat JExpr
f [JExpr]
args)      = JExpr -> [JExpr] -> JStat
ApplStat   (JExpr -> JExpr
e_opt JExpr
f) (JExpr -> JExpr
e_opt (JExpr -> JExpr) -> [JExpr] -> [JExpr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [JExpr]
args)
    -- all else is terminal, we match on these to force a warning in the event
    -- another constructor is added
    go x :: JStat
x@BreakStat{}          = JStat
x
    go x :: JStat
x@ContinueStat{}       = JStat
x
    go x :: JStat
x@DeclStat{}           = JStat
x -- match on the nothing case

jsOptimize' :: [JStat] -> [JStat]
jsOptimize' :: [JStat] -> [JStat]
jsOptimize' = BlockOpt -> [JStat] -> [JStat]
runBlockOpt BlockOpt
opts ([JStat] -> [JStat]) -> ([JStat] -> [JStat]) -> [JStat] -> [JStat]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JStat] -> [JStat]
single_pass_opts
  where
    opts :: BlockOpt
    opts :: BlockOpt
opts =  BlockOpt
safe_opts
            BlockOpt -> BlockOpt -> BlockOpt
forall a. Semigroup a => a -> a -> a
<> BlockOpt
unsafe_opts
            BlockOpt -> BlockOpt -> BlockOpt
forall a. Semigroup a => a -> a -> a
<> BlockOpt
tailLoop  -- tailloop must be last, see module description

    unsafe_opts :: BlockOpt
    unsafe_opts :: BlockOpt
unsafe_opts = [BlockOpt] -> BlockOpt
forall a. Monoid a => [a] -> a
mconcat [ BlockOpt
deadCodeElim ]

    safe_opts :: BlockOpt
    safe_opts :: BlockOpt
safe_opts = [BlockOpt] -> BlockOpt
forall a. Monoid a => [a] -> a
mconcat [ BlockOpt
declareAssign, BlockOpt
combineOps ]

    single_pass_opts :: BlockTrans
    single_pass_opts :: [JStat] -> [JStat]
single_pass_opts = [[JStat] -> [JStat]] -> [JStat] -> [JStat]
runBlockTrans [[JStat] -> [JStat]]
sp_opts

    sp_opts :: [[JStat] -> [JStat]]
sp_opts = [[JStat] -> [JStat]
flattenBlocks]

-- | recur over a @JExpr@ and optimize the @JVal@s
jExprOptimize :: JExpr -> JExpr
-- the base case
jExprOptimize :: JExpr -> JExpr
jExprOptimize (ValExpr JVal
val)       = JVal -> JExpr
ValExpr (JVal -> JVal
jValOptimize JVal
val)
-- recursive cases
jExprOptimize (SelExpr JExpr
obj Ident
field) = JExpr -> Ident -> JExpr
SelExpr (JExpr -> JExpr
jExprOptimize JExpr
obj) Ident
field
jExprOptimize (IdxExpr JExpr
obj JExpr
ix)    = JExpr -> JExpr -> JExpr
IdxExpr (JExpr -> JExpr
jExprOptimize JExpr
obj) (JExpr -> JExpr
jExprOptimize JExpr
ix)
jExprOptimize (UOpExpr UOp
op JExpr
exp)    = UOp -> JExpr -> JExpr
UOpExpr UOp
op (JExpr -> JExpr
jExprOptimize JExpr
exp)
jExprOptimize (IfExpr JExpr
c JExpr
t JExpr
e)      = JExpr -> JExpr -> JExpr -> JExpr
IfExpr JExpr
c (JExpr -> JExpr
jExprOptimize JExpr
t) (JExpr -> JExpr
jExprOptimize JExpr
e)
jExprOptimize (ApplExpr JExpr
f [JExpr]
args )  = JExpr -> [JExpr] -> JExpr
ApplExpr (JExpr -> JExpr
jExprOptimize JExpr
f) (JExpr -> JExpr
jExprOptimize (JExpr -> JExpr) -> [JExpr] -> [JExpr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [JExpr]
args)
jExprOptimize (InfixExpr Op
op JExpr
l JExpr
r)  = Op -> JExpr -> JExpr -> JExpr
InfixExpr Op
op (JExpr -> JExpr
jExprOptimize JExpr
l) (JExpr -> JExpr
jExprOptimize JExpr
r)

-- | drive optimizations to anonymous functions and over expressions
jValOptimize ::  JVal -> JVal
-- base case
jValOptimize :: JVal -> JVal
jValOptimize (JFunc [Ident]
args JStat
body) = [Ident] -> JStat -> JVal
JFunc [Ident]
args (JStat -> JStat
jsOptimizeStat JStat
body)
-- recursive cases
jValOptimize (JList [JExpr]
exprs)     = [JExpr] -> JVal
JList (JExpr -> JExpr
jExprOptimize (JExpr -> JExpr) -> [JExpr] -> [JExpr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [JExpr]
exprs)
jValOptimize (JHash UniqMap FastString JExpr
hash)      = UniqMap FastString JExpr -> JVal
JHash (JExpr -> JExpr
jExprOptimize (JExpr -> JExpr)
-> UniqMap FastString JExpr -> UniqMap FastString JExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UniqMap FastString JExpr
hash)
-- all else is terminal
jValOptimize x :: JVal
x@JVar{}          = JVal
x
jValOptimize x :: JVal
x@JDouble{}       = JVal
x
jValOptimize x :: JVal
x@JInt{}          = JVal
x
jValOptimize x :: JVal
x@JStr{}          = JVal
x
jValOptimize x :: JVal
x@JRegEx{}        = JVal
x
jValOptimize x :: JVal
x@JBool{}         = JVal
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 ([JStat] -> [JStat]) -> ([JStat] -> [JStat]) -> [JStat] -> [JStat]
opt0 <> :: BlockOpt -> BlockOpt -> BlockOpt
<> BlockOpt ([JStat] -> [JStat]) -> ([JStat] -> [JStat]) -> [JStat] -> [JStat]
opt1 = (([JStat] -> [JStat])
 -> ([JStat] -> [JStat]) -> [JStat] -> [JStat])
-> BlockOpt
BlockOpt
    ((([JStat] -> [JStat])
  -> ([JStat] -> [JStat]) -> [JStat] -> [JStat])
 -> BlockOpt)
-> (([JStat] -> [JStat])
    -> ([JStat] -> [JStat]) -> [JStat] -> [JStat])
-> BlockOpt
forall a b. (a -> b) -> a -> b
$ \[JStat] -> [JStat]
loop [JStat] -> [JStat]
next -> ([JStat] -> [JStat]) -> ([JStat] -> [JStat]) -> [JStat] -> [JStat]
opt0 [JStat] -> [JStat]
loop (([JStat] -> [JStat]) -> ([JStat] -> [JStat]) -> [JStat] -> [JStat]
opt1 [JStat] -> [JStat]
loop [JStat] -> [JStat]
next)

instance Monoid BlockOpt where
  -- don't loop, just finalize
  mempty :: BlockOpt
mempty = (([JStat] -> [JStat])
 -> ([JStat] -> [JStat]) -> [JStat] -> [JStat])
-> BlockOpt
BlockOpt ((([JStat] -> [JStat])
  -> ([JStat] -> [JStat]) -> [JStat] -> [JStat])
 -> BlockOpt)
-> (([JStat] -> [JStat])
    -> ([JStat] -> [JStat]) -> [JStat] -> [JStat])
-> BlockOpt
forall a b. (a -> b) -> a -> b
$ \[JStat] -> [JStat]
_loop [JStat] -> [JStat]
next -> [JStat] -> [JStat]
next

-- | loop until a fixpoint is reached
runBlockOpt :: BlockOpt -> [JStat] -> [JStat]
runBlockOpt :: BlockOpt -> [JStat] -> [JStat]
runBlockOpt (BlockOpt ([JStat] -> [JStat]) -> ([JStat] -> [JStat]) -> [JStat] -> [JStat]
opt) [JStat]
xs = [JStat] -> [JStat]
recur [JStat]
xs
  where recur :: [JStat] -> [JStat]
recur = ([JStat] -> [JStat]) -> ([JStat] -> [JStat]) -> [JStat] -> [JStat]
opt [JStat] -> [JStat]
recur [JStat] -> [JStat]
forall a. a -> a
id

runBlockTrans :: [BlockTrans] -> [JStat] -> [JStat]
runBlockTrans :: [[JStat] -> [JStat]] -> [JStat] -> [JStat]
runBlockTrans [[JStat] -> [JStat]]
opts = (([JStat] -> [JStat])
 -> ([JStat] -> [JStat]) -> [JStat] -> [JStat])
-> ([JStat] -> [JStat])
-> [[JStat] -> [JStat]]
-> [JStat]
-> [JStat]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ([JStat] -> [JStat]) -> ([JStat] -> [JStat]) -> [JStat] -> [JStat]
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) [JStat] -> [JStat]
forall a. a -> a
id [[JStat] -> [JStat]]
opts

-- | Perform all the optimizations on the tail of a block.
tailLoop :: BlockOpt
tailLoop :: BlockOpt
tailLoop = (([JStat] -> [JStat])
 -> ([JStat] -> [JStat]) -> [JStat] -> [JStat])
-> BlockOpt
BlockOpt ((([JStat] -> [JStat])
  -> ([JStat] -> [JStat]) -> [JStat] -> [JStat])
 -> BlockOpt)
-> (([JStat] -> [JStat])
    -> ([JStat] -> [JStat]) -> [JStat] -> [JStat])
-> BlockOpt
forall a b. (a -> b) -> a -> b
$ \[JStat] -> [JStat]
loop [JStat] -> [JStat]
next -> \case
    []     -> [JStat] -> [JStat]
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
    (JStat
x:[JStat]
xs) -> [JStat] -> [JStat]
next (JStat -> JStat
jsOptimizeStat JStat
x JStat -> [JStat] -> [JStat]
forall a. a -> [a] -> [a]
: [JStat] -> [JStat]
loop [JStat]
xs)

{- |
   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
combineOps = (([JStat] -> [JStat])
 -> ([JStat] -> [JStat]) -> [JStat] -> [JStat])
-> BlockOpt
BlockOpt ((([JStat] -> [JStat])
  -> ([JStat] -> [JStat]) -> [JStat] -> [JStat])
 -> BlockOpt)
-> (([JStat] -> [JStat])
    -> ([JStat] -> [JStat]) -> [JStat] -> [JStat])
-> BlockOpt
forall a b. (a -> b) -> a -> b
$ \[JStat] -> [JStat]
loop [JStat] -> [JStat]
next ->
    -- find an op pattern, and rerun the optimizer on its result unless there is
    -- nothing to optimize, in which case call the next optimization
  \case
    -- var x = expr; return x; ==> return expr;
    (DeclStat Ident
i (Just JExpr
e) : ReturnStat (ValExpr (JVar Ident
i')) : [JStat]
xs)
      | Ident
i Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
i' -> [JStat] -> [JStat]
loop ([JStat] -> [JStat]) -> [JStat] -> [JStat]
forall a b. (a -> b) -> a -> b
$ JExpr -> JStat
ReturnStat JExpr
e JStat -> [JStat] -> [JStat]
forall a. a -> [a] -> [a]
: [JStat]
xs

    -- x = expr; return x; ==> return expr;
    (AssignStat (ValExpr (JVar Ident
i)) AOp
AssignOp JExpr
e : ReturnStat (ValExpr (JVar Ident
i')) : [JStat]
xs)
      | Ident
i Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
i' -> [JStat] -> [JStat]
loop ([JStat] -> [JStat]) -> [JStat] -> [JStat]
forall a b. (a -> b) -> a -> b
$ JExpr -> JStat
ReturnStat JExpr
e JStat -> [JStat] -> [JStat]
forall a. a -> [a] -> [a]
: [JStat]
xs

    -- h$sp -= 2; h$sp += 5; ==> h$sp += 3;
    (JStat
op1 : JStat
op2 : [JStat]
xs)
      | Just Integer
s1 <- JStat -> Maybe Integer
isStackAdjust JStat
op1
      , Just Integer
s2 <- JStat -> Maybe Integer
isStackAdjust JStat
op2 -> [JStat] -> [JStat]
loop ([JStat] -> [JStat]) -> [JStat] -> [JStat]
forall a b. (a -> b) -> a -> b
$ Integer -> [JStat]
mkStackAdjust (Integer
s1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
s2) [JStat] -> [JStat] -> [JStat]
forall a. [a] -> [a] -> [a]
++ [JStat]
xs

    -- x = x + 1; ==> ++x;
    -- x = x - 1; ==> --x;
    -- x = x + n; ==> x += n;
    -- x = x - n; ==> x -= n;
    (unchanged :: JStat
unchanged@(AssignStat
                  ident :: JExpr
ident@(ValExpr (JVar Ident
i))
                  AOp
AssignOp
                  (InfixExpr Op
op (ValExpr (JVar Ident
i')) JExpr
e)) : [JStat]
xs)
      | Ident
i Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
i' -> case (Op
op, JExpr
e) of
                     (Op
AddOp, (ValExpr (JInt Integer
1))) -> [JStat] -> [JStat]
loop ([JStat] -> [JStat]) -> [JStat] -> [JStat]
forall a b. (a -> b) -> a -> b
$ UOp -> JExpr -> JStat
UOpStat UOp
PreIncOp JExpr
ident          JStat -> [JStat] -> [JStat]
forall a. a -> [a] -> [a]
: [JStat]
xs
                     (Op
SubOp, (ValExpr (JInt Integer
1))) -> [JStat] -> [JStat]
loop ([JStat] -> [JStat]) -> [JStat] -> [JStat]
forall a b. (a -> b) -> a -> b
$ UOp -> JExpr -> JStat
UOpStat UOp
PreDecOp JExpr
ident          JStat -> [JStat] -> [JStat]
forall a. a -> [a] -> [a]
: [JStat]
xs
                     (Op
AddOp, JExpr
e')                 -> [JStat] -> [JStat]
loop ([JStat] -> [JStat]) -> [JStat] -> [JStat]
forall a b. (a -> b) -> a -> b
$ JExpr -> AOp -> JExpr -> JStat
AssignStat JExpr
ident AOp
AddAssignOp JExpr
e' JStat -> [JStat] -> [JStat]
forall a. a -> [a] -> [a]
: [JStat]
xs
                     (Op
SubOp, JExpr
e')                 -> [JStat] -> [JStat]
loop ([JStat] -> [JStat]) -> [JStat] -> [JStat]
forall a b. (a -> b) -> a -> b
$ JExpr -> AOp -> JExpr -> JStat
AssignStat JExpr
ident AOp
SubAssignOp JExpr
e' JStat -> [JStat] -> [JStat]
forall a. a -> [a] -> [a]
: [JStat]
xs
                     (Op, JExpr)
_                           -> [JStat] -> [JStat]
next ([JStat] -> [JStat]) -> [JStat] -> [JStat]
forall a b. (a -> b) -> a -> b
$ JStat
unchanged JStat -> [JStat] -> [JStat]
forall a. a -> [a] -> [a]
: [JStat]
xs
    -- commutative cases
    (unchanged :: JStat
unchanged@(AssignStat
                  ident :: JExpr
ident@(ValExpr (JVar Ident
i))
                  AOp
AssignOp
                  (InfixExpr Op
op JExpr
e (ValExpr (JVar Ident
i')))) : [JStat]
xs)
      | Ident
i Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
i' -> case (Op
op, JExpr
e) of
                     (Op
AddOp, (ValExpr (JInt Integer
1))) -> [JStat] -> [JStat]
loop ([JStat] -> [JStat]) -> [JStat] -> [JStat]
forall a b. (a -> b) -> a -> b
$ UOp -> JExpr -> JStat
UOpStat UOp
PreIncOp JExpr
ident          JStat -> [JStat] -> [JStat]
forall a. a -> [a] -> [a]
: [JStat]
xs
                     (Op
AddOp, JExpr
e')                 -> [JStat] -> [JStat]
loop ([JStat] -> [JStat]) -> [JStat] -> [JStat]
forall a b. (a -> b) -> a -> b
$ JExpr -> AOp -> JExpr -> JStat
AssignStat JExpr
ident AOp
AddAssignOp JExpr
e' JStat -> [JStat] -> [JStat]
forall a. a -> [a] -> [a]
: [JStat]
xs
                     (Op, JExpr)
_                           -> [JStat] -> [JStat]
next ([JStat] -> [JStat]) -> [JStat] -> [JStat]
forall a b. (a -> b) -> a -> b
$ JStat
unchanged JStat -> [JStat] -> [JStat]
forall a. a -> [a] -> [a]
: [JStat]
xs
    -- general case, we had nothing to optimize in this case so call the next
    -- optimization
    [JStat]
xs -> [JStat] -> [JStat]
next [JStat]
xs


-- | Catch 'var i; i = q;' ==> 'var i = q;'
declareAssign :: BlockOpt
declareAssign :: BlockOpt
declareAssign = (([JStat] -> [JStat])
 -> ([JStat] -> [JStat]) -> [JStat] -> [JStat])
-> BlockOpt
BlockOpt ((([JStat] -> [JStat])
  -> ([JStat] -> [JStat]) -> [JStat] -> [JStat])
 -> BlockOpt)
-> (([JStat] -> [JStat])
    -> ([JStat] -> [JStat]) -> [JStat] -> [JStat])
-> BlockOpt
forall a b. (a -> b) -> a -> b
$
  \[JStat] -> [JStat]
loop [JStat] -> [JStat]
next -> \case
    ( (DeclStat Ident
i Maybe JExpr
Nothing)
      : (AssignStat (ValExpr (JVar Ident
i')) AOp
AssignOp JExpr
v)
      : [JStat]
xs
      )  | Ident
i Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
i' -> [JStat] -> [JStat]
loop (Ident -> Maybe JExpr -> JStat
DeclStat Ident
i (JExpr -> Maybe JExpr
forall a. a -> Maybe a
Just JExpr
v) JStat -> [JStat] -> [JStat]
forall a. a -> [a] -> [a]
: [JStat]
xs)
    [JStat]
xs -> [JStat] -> [JStat]
next [JStat]
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
deadCodeElim = (([JStat] -> [JStat])
 -> ([JStat] -> [JStat]) -> [JStat] -> [JStat])
-> BlockOpt
BlockOpt ((([JStat] -> [JStat])
  -> ([JStat] -> [JStat]) -> [JStat] -> [JStat])
 -> BlockOpt)
-> (([JStat] -> [JStat])
    -> ([JStat] -> [JStat]) -> [JStat] -> [JStat])
-> BlockOpt
forall a b. (a -> b) -> a -> b
$
  \[JStat] -> [JStat]
_loop [JStat] -> [JStat]
next -> \case
    (x :: JStat
x@ReturnStat{}:[JStat]
_) -> [JStat] -> [JStat]
next [JStat
x]
    [JStat]
xs                 -> [JStat] -> [JStat]
next [JStat]
xs

-- | remove nested blocks
flattenBlocks :: BlockTrans
flattenBlocks :: [JStat] -> [JStat]
flattenBlocks (BlockStat [JStat]
y : [JStat]
ys) = [JStat] -> [JStat]
flattenBlocks [JStat]
y [JStat] -> [JStat] -> [JStat]
forall a. [a] -> [a] -> [a]
++ [JStat] -> [JStat]
flattenBlocks [JStat]
ys
flattenBlocks (JStat
x:[JStat]
xs)             = JStat
x JStat -> [JStat] -> [JStat]
forall a. a -> [a] -> [a]
: [JStat] -> [JStat]
flattenBlocks [JStat]
xs
flattenBlocks []                 = []

-- | stack adjustments
sp :: JExpr
sp :: JExpr
sp = JVal -> JExpr
ValExpr (Ident -> JVal
JVar (FastString -> Ident
TxtI FastString
"h$sp"))

isStackAdjust :: JStat -> Maybe Integer
isStackAdjust :: JStat -> Maybe Integer
isStackAdjust (UOpStat UOp
op (ValExpr (JVar (TxtI FastString
"h$sp"))))
  | UOp
op UOp -> UOp -> Bool
forall a. Eq a => a -> a -> Bool
== UOp
PreIncOp Bool -> Bool -> Bool
|| UOp
op UOp -> UOp -> Bool
forall a. Eq a => a -> a -> Bool
== UOp
PostIncOp = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
1
isStackAdjust (UOpStat UOp
op (ValExpr (JVar (TxtI FastString
"h$sp"))))
  | UOp
op UOp -> UOp -> Bool
forall a. Eq a => a -> a -> Bool
== UOp
PreDecOp Bool -> Bool -> Bool
|| UOp
op UOp -> UOp -> Bool
forall a. Eq a => a -> a -> Bool
== UOp
PostDecOp = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (-Integer
1)
isStackAdjust (AssignStat (ValExpr (JVar (TxtI FastString
"h$sp"))) AOp
op (ValExpr (JInt Integer
n)))
  | AOp
op AOp -> AOp -> Bool
forall a. Eq a => a -> a -> Bool
== AOp
AddAssignOp = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
n
  | AOp
op AOp -> AOp -> Bool
forall a. Eq a => a -> a -> Bool
== AOp
SubAssignOp = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (-Integer
n)
isStackAdjust (AssignStat (ValExpr (JVar (TxtI FastString
"h$sp"))) AOp
AssignOp (InfixExpr Op
op (ValExpr (JVar (TxtI FastString
"h$sp"))) (ValExpr (JInt Integer
n))))
  | Op
op Op -> Op -> Bool
forall a. Eq a => a -> a -> Bool
== Op
AddOp = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
n
  | Op
op Op -> Op -> Bool
forall a. Eq a => a -> a -> Bool
== Op
SubOp = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (-Integer
n)
isStackAdjust (AssignStat (ValExpr (JVar (TxtI FastString
"h$sp"))) AOp
AssignOp (InfixExpr Op
AddOp (ValExpr (JInt Integer
n)) (ValExpr (JVar (TxtI FastString
"h$sp")))))
  = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
n
isStackAdjust JStat
_ = Maybe Integer
forall a. Maybe a
Nothing

mkStackAdjust :: Integer -> [JStat]
mkStackAdjust :: Integer -> [JStat]
mkStackAdjust Integer
0 = []
mkStackAdjust Integer
1 = [UOp -> JExpr -> JStat
UOpStat UOp
PostIncOp JExpr
sp]
mkStackAdjust (-1) = [UOp -> JExpr -> JStat
UOpStat UOp
PostDecOp JExpr
sp]
mkStackAdjust Integer
x
  | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = [JExpr -> AOp -> JExpr -> JStat
AssignStat JExpr
sp AOp
AssignOp (Op -> JExpr -> JExpr -> JExpr
InfixExpr Op
SubOp JExpr
sp (JVal -> JExpr
ValExpr (Integer -> JVal
JInt (-Integer
x))))]
  | Bool
otherwise = [JExpr -> AOp -> JExpr -> JStat
AssignStat JExpr
sp AOp
AssignOp (Op -> JExpr -> JExpr -> JExpr
InfixExpr Op
AddOp JExpr
sp (JVal -> JExpr
ValExpr (Integer -> JVal
JInt Integer
x)))]