{-# LANGUAGE LambdaCase #-}
module GHC.JS.Optimizer
 ( jsOptimize
 ) where
import Prelude
import GHC.JS.Syntax
import Control.Arrow
jsOptimize :: JStat -> JStat
jsOptimize :: JStat -> JStat
jsOptimize = JStat -> JStat
go
  where
    p_opt :: JStat -> JStat
p_opt = JStat -> JStat
jsOptimize
    opt :: [JStat] -> [JStat]
opt   = [JStat] -> [JStat]
jsOptimize'
    e_opt :: JExpr -> JExpr
e_opt = JExpr -> JExpr
jExprOptimize
    
    go :: JStat -> JStat
go (BlockStat [JStat]
xs) = [JStat] -> JStat
BlockStat ([JStat] -> [JStat]
opt [JStat]
xs)
    
    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)
    
    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)
    
    
    go x :: JStat
x@BreakStat{}          = JStat
x
    go x :: JStat
x@ContinueStat{}       = JStat
x
    go x :: JStat
x@DeclStat{}           = JStat
x 
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  
    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]
jExprOptimize :: JExpr -> JExpr
jExprOptimize :: JExpr -> JExpr
jExprOptimize (ValExpr JVal
val)       = JVal -> JExpr
ValExpr (JVal -> JVal
jValOptimize JVal
val)
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)
jValOptimize ::  JVal -> JVal
jValOptimize :: JVal -> JVal
jValOptimize (JFunc [Ident]
args JStat
body) = [Ident] -> JStat -> JVal
JFunc [Ident]
args (JStat -> JStat
jsOptimize JStat
body)
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)
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
type BlockTrans = [JStat] -> [JStat]
newtype BlockOpt = BlockOpt (BlockTrans -> BlockTrans -> BlockTrans)
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
  
  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
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
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 []
    
    
    
    (JStat
x:[JStat]
xs) -> [JStat] -> [JStat]
next (JStat -> JStat
jsOptimize JStat
x JStat -> [JStat] -> [JStat]
forall a. a -> [a] -> [a]
: [JStat] -> [JStat]
loop [JStat]
xs)
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 ->
  \case
    
    
    (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
    
    (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
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
    
    
    [JStat]
xs -> [JStat] -> [JStat]
next [JStat]
xs
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
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
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 []                 = []