{-# 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 [] = []