{-# LANGUAGE ViewPatterns #-}
module GHC.JS.Opt.Expr (optExprs) where
import GHC.Prelude hiding (shiftL, shiftR)
import GHC.JS.Syntax
import Data.Bifunctor (second)
import Data.Bits (shiftL, shiftR, (.^.))
import Data.Int (Int32)
optExprs :: JStat -> JStat
optExprs :: JStat -> JStat
optExprs JStat
s = JStat -> JStat
go JStat
s
where
go :: JStat -> JStat
go (DeclStat Ident
v Maybe JExpr
mb_e) = Ident -> Maybe JExpr -> JStat
DeclStat Ident
v ((JExpr -> JExpr) -> Maybe JExpr -> Maybe JExpr
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JExpr -> JExpr
opt Maybe JExpr
mb_e)
go (AssignStat JExpr
lhs AOp
op JExpr
rhs) = JExpr -> AOp -> JExpr -> JStat
AssignStat (JExpr -> JExpr
opt JExpr
lhs) AOp
op (JExpr -> JExpr
opt JExpr
rhs)
go (ReturnStat JExpr
e) = JExpr -> JStat
ReturnStat (JExpr -> JExpr
opt JExpr
e)
go (BlockStat [JStat]
ss) = [JStat] -> JStat
BlockStat ((JStat -> JStat) -> [JStat] -> [JStat]
forall a b. (a -> b) -> [a] -> [b]
map JStat -> JStat
go [JStat]
ss)
go (IfStat JExpr
e JStat
s1 JStat
s2) = JExpr -> JStat -> JStat -> JStat
IfStat (JExpr -> JExpr
optCond JExpr
e) (JStat -> JStat
go JStat
s1) (JStat -> JStat
go JStat
s2)
go (WhileStat Bool
b JExpr
e JStat
s) = Bool -> JExpr -> JStat -> JStat
WhileStat Bool
b (JExpr -> JExpr
optCond JExpr
e) (JStat -> JStat
go JStat
s)
go (ForStat JStat
s1 JExpr
e JStat
s2 JStat
s3) = JStat -> JExpr -> JStat -> JStat -> JStat
ForStat (JStat -> JStat
go JStat
s1) (JExpr -> JExpr
optCond JExpr
e) (JStat -> JStat
go JStat
s2) (JStat -> JStat
go JStat
s3)
go (ForInStat Bool
b Ident
v JExpr
e JStat
s) = Bool -> Ident -> JExpr -> JStat -> JStat
ForInStat Bool
b Ident
v (JExpr -> JExpr
opt JExpr
e) (JStat -> JStat
go JStat
s)
go (SwitchStat JExpr
e [(JExpr, JStat)]
cases JStat
s) = JExpr -> [(JExpr, JStat)] -> JStat -> JStat
SwitchStat (JExpr -> JExpr
opt JExpr
e)
(((JExpr, JStat) -> (JExpr, JStat))
-> [(JExpr, JStat)] -> [(JExpr, JStat)]
forall a b. (a -> b) -> [a] -> [b]
map ((JStat -> JStat) -> (JExpr, JStat) -> (JExpr, JStat)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second JStat -> JStat
go) [(JExpr, JStat)]
cases)
(JStat -> JStat
go JStat
s)
go (TryStat JStat
s1 Ident
v JStat
s2 JStat
s3) = JStat -> Ident -> JStat -> JStat -> JStat
TryStat (JStat -> JStat
go JStat
s1) Ident
v (JStat -> JStat
go JStat
s2) (JStat -> JStat
go JStat
s3)
go (ApplStat JExpr
e [JExpr]
es) = JExpr -> [JExpr] -> JStat
ApplStat (JExpr -> JExpr
opt JExpr
e) ((JExpr -> JExpr) -> [JExpr] -> [JExpr]
forall a b. (a -> b) -> [a] -> [b]
map JExpr -> JExpr
opt [JExpr]
es)
go (UOpStat UOp
op JExpr
e) = UOp -> JExpr -> JStat
UOpStat UOp
op (JExpr -> JExpr
opt JExpr
e)
go (LabelStat JLabel
lbl JStat
s) = JLabel -> JStat -> JStat
LabelStat JLabel
lbl (JStat -> JStat
go JStat
s)
go s :: JStat
s@(BreakStat{}) = JStat
s
go s :: JStat
s@(ContinueStat{}) = JStat
s
go (FuncStat Ident
n [Ident]
vs JStat
s) = Ident -> [Ident] -> JStat -> JStat
FuncStat Ident
n [Ident]
vs (JStat -> JStat
go JStat
s)
optCond :: JExpr -> JExpr
optCond :: JExpr -> JExpr
optCond JExpr
e = let f :: JExpr -> JExpr
f (UOpExpr UOp
NotOp (UOpExpr UOp
NotOp JExpr
e')) = JExpr -> JExpr
f JExpr
e'
f JExpr
e' = JExpr
e'
in JExpr -> JExpr
f (JExpr -> JExpr
opt JExpr
e)
opt :: JExpr -> JExpr
opt :: JExpr -> JExpr
opt (ValExpr JVal
v) = JVal -> JExpr
ValExpr JVal
v
opt (SelExpr JExpr
e Ident
i) = JExpr -> Ident -> JExpr
SelExpr (JExpr -> JExpr
opt JExpr
e) Ident
i
opt (IdxExpr JExpr
e1 JExpr
e2) = JExpr -> JExpr -> JExpr
IdxExpr (JExpr -> JExpr
opt JExpr
e1) (JExpr -> JExpr
opt JExpr
e2)
opt(InfixExpr Op
StrictEqOp (IfExpr JExpr
c_e (JExpr -> JExpr
opt -> JExpr
t_e) (JExpr -> JExpr
opt -> JExpr
f_e)) (JExpr -> JExpr
opt -> JExpr
e))
| ValExpr JVal
t_v <- JExpr
t_e
, ValExpr JVal
v <- JExpr
e
, JVal -> JVal -> Bool
eqVal JVal
t_v JVal
v = UOp -> JExpr -> JExpr
UOpExpr UOp
NotOp (UOp -> JExpr -> JExpr
UOpExpr UOp
NotOp JExpr
c_e)
| ValExpr JVal
f_v <- JExpr
f_e
, ValExpr JVal
v <- JExpr
e
, JVal -> JVal -> Bool
eqVal JVal
f_v JVal
v = UOp -> JExpr -> JExpr
UOpExpr UOp
NotOp (JExpr -> JExpr
opt JExpr
c_e)
| Bool
otherwise = Op -> JExpr -> JExpr -> JExpr
InfixExpr Op
StrictEqOp (JExpr -> JExpr -> JExpr -> JExpr
IfExpr JExpr
c_e JExpr
t_e JExpr
f_e) JExpr
e
opt(InfixExpr Op
StrictEqOp (JExpr -> JExpr
opt -> JExpr
e) (IfExpr (JExpr -> JExpr
opt -> JExpr
c_e) (JExpr -> JExpr
opt -> JExpr
t_e) (JExpr -> JExpr
opt -> JExpr
f_e)))
| ValExpr JVal
t_v <- JExpr
t_e
, ValExpr JVal
v <- JExpr
e
, JVal -> JVal -> Bool
eqVal JVal
t_v JVal
v = UOp -> JExpr -> JExpr
UOpExpr UOp
NotOp (UOp -> JExpr -> JExpr
UOpExpr UOp
NotOp JExpr
c_e)
| ValExpr JVal
f_v <- JExpr
f_e
, ValExpr JVal
v <- JExpr
e
, JVal -> JVal -> Bool
eqVal JVal
f_v JVal
v = UOp -> JExpr -> JExpr
UOpExpr UOp
NotOp JExpr
c_e
| Bool
otherwise = Op -> JExpr -> JExpr -> JExpr
InfixExpr Op
StrictEqOp JExpr
e (JExpr -> JExpr -> JExpr -> JExpr
IfExpr JExpr
c_e JExpr
t_e JExpr
f_e)
opt (InfixExpr Op
op (JExpr -> JExpr
opt -> JExpr
e1) (JExpr -> JExpr
opt -> JExpr
e2))
| (ValExpr (JInt Integer
n1)) <- JExpr
e1
, (ValExpr (JInt Integer
n2)) <- JExpr
e2
, Just JVal
v <- Op -> Integer -> Integer -> Maybe JVal
optInt Op
op Integer
n1 Integer
n2 = JVal -> JExpr
ValExpr JVal
v
| (ValExpr (JBool Bool
b1)) <- JExpr
e1
, (ValExpr (JBool Bool
b2)) <- JExpr
e2
, Just JVal
v <- Op -> Bool -> Bool -> Maybe JVal
optBool Op
op Bool
b1 Bool
b2 = JVal -> JExpr
ValExpr JVal
v
| Bool
otherwise = Op -> JExpr -> JExpr -> JExpr
InfixExpr Op
op JExpr
e1 JExpr
e2
opt (UOpExpr UOp
op JExpr
e) = UOp -> JExpr -> JExpr
UOpExpr UOp
op (JExpr -> JExpr
opt JExpr
e)
opt (IfExpr JExpr
e1 JExpr
e2 JExpr
e3) = JExpr -> JExpr -> JExpr -> JExpr
IfExpr (JExpr -> JExpr
optCond JExpr
e1) (JExpr -> JExpr
opt JExpr
e2) (JExpr -> JExpr
opt JExpr
e3)
opt (ApplExpr JExpr
e [JExpr]
es) = JExpr -> [JExpr] -> JExpr
ApplExpr (JExpr -> JExpr
opt JExpr
e) ((JExpr -> JExpr) -> [JExpr] -> [JExpr]
forall a b. (a -> b) -> [a] -> [b]
map JExpr -> JExpr
opt [JExpr]
es)
optBool :: Op -> Bool -> Bool -> Maybe JVal
optBool :: Op -> Bool -> Bool -> Maybe JVal
optBool Op
LAndOp Bool
x Bool
y = JVal -> Maybe JVal
forall a. a -> Maybe a
Just (Bool -> JVal
JBool (Bool
x Bool -> Bool -> Bool
&& Bool
y))
optBool Op
LOrOp Bool
x Bool
y = JVal -> Maybe JVal
forall a. a -> Maybe a
Just (Bool -> JVal
JBool (Bool
x Bool -> Bool -> Bool
|| Bool
y))
optBool Op
EqOp Bool
x Bool
y = JVal -> Maybe JVal
forall a. a -> Maybe a
Just (Bool -> JVal
JBool (Bool
x Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
y))
optBool Op
StrictEqOp Bool
x Bool
y = JVal -> Maybe JVal
forall a. a -> Maybe a
Just (Bool -> JVal
JBool (Bool
x Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
y))
optBool Op
NeqOp Bool
x Bool
y = JVal -> Maybe JVal
forall a. a -> Maybe a
Just (Bool -> JVal
JBool (Bool
x Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
y))
optBool Op
StrictNeqOp Bool
x Bool
y = JVal -> Maybe JVal
forall a. a -> Maybe a
Just (Bool -> JVal
JBool (Bool
x Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
y))
optBool Op
_ Bool
_ Bool
_ = Maybe JVal
forall a. Maybe a
Nothing
optInt :: Op -> Integer -> Integer -> Maybe JVal
optInt :: Op -> Integer -> Integer -> Maybe JVal
optInt Op
ZRightShiftOp Integer
n Integer
m = JVal -> Maybe JVal
forall a. a -> Maybe a
Just (JVal -> Maybe JVal) -> JVal -> Maybe JVal
forall a b. (a -> b) -> a -> b
$
Integer -> JVal
JInt (Integer -> Integer
forall a. Integral a => a -> Integer
toInteger (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ (Integer
n Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
0xffffffff) Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer
m Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
0x1f))
optInt Op
BOrOp Integer
n Integer
m = JVal -> Maybe JVal
forall a. a -> Maybe a
Just ((Int32 -> Int32 -> Int32) -> Integer -> Integer -> JVal
truncOp Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
(.|.) Integer
n Integer
m)
optInt Op
BAndOp Integer
n Integer
m = JVal -> Maybe JVal
forall a. a -> Maybe a
Just ((Int32 -> Int32 -> Int32) -> Integer -> Integer -> JVal
truncOp Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
(.&.) Integer
n Integer
m)
optInt Op
BXorOp Integer
n Integer
m = JVal -> Maybe JVal
forall a. a -> Maybe a
Just ((Int32 -> Int32 -> Int32) -> Integer -> Integer -> JVal
truncOp Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
(.^.) Integer
n Integer
m)
optInt Op
RightShiftOp Integer
n Integer
m = JVal -> Maybe JVal
forall a. a -> Maybe a
Just ((Int32 -> Int -> Int32) -> Integer -> Integer -> JVal
shiftOp Int32 -> Int -> Int32
forall a. Bits a => a -> Int -> a
shiftR Integer
n Integer
m)
optInt Op
LeftShiftOp Integer
n Integer
m = JVal -> Maybe JVal
forall a. a -> Maybe a
Just ((Int32 -> Int -> Int32) -> Integer -> Integer -> JVal
shiftOp Int32 -> Int -> Int32
forall a. Bits a => a -> Int -> a
shiftL Integer
n Integer
m)
optInt Op
AddOp Integer
n Integer
m = (Integer -> Integer -> Integer) -> Integer -> Integer -> Maybe JVal
smallIntOp Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+) Integer
n Integer
m
optInt Op
SubOp Integer
n Integer
m = (Integer -> Integer -> Integer) -> Integer -> Integer -> Maybe JVal
smallIntOp (-) Integer
n Integer
m
optInt Op
MulOp Integer
n Integer
m = (Integer -> Integer -> Integer) -> Integer -> Integer -> Maybe JVal
smallIntOp Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*) Integer
n Integer
m
optInt Op
op Integer
n Integer
m
| Just Integer -> Integer -> Bool
cmp <- Op -> Maybe (Integer -> Integer -> Bool)
getCmpOp Op
op, Integer -> Bool
isSmall52 Integer
n Bool -> Bool -> Bool
&& Integer -> Bool
isSmall52 Integer
m
= JVal -> Maybe JVal
forall a. a -> Maybe a
Just (Bool -> JVal
JBool (Integer -> Integer -> Bool
cmp Integer
n Integer
m))
optInt Op
_ Integer
_ Integer
_ = Maybe JVal
forall a. Maybe a
Nothing
smallIntOp :: (Integer -> Integer -> Integer)
-> Integer -> Integer -> Maybe JVal
smallIntOp :: (Integer -> Integer -> Integer) -> Integer -> Integer -> Maybe JVal
smallIntOp Integer -> Integer -> Integer
op Integer
n Integer
m
| Integer -> Bool
isSmall52 Integer
n Bool -> Bool -> Bool
&& Integer -> Bool
isSmall52 Integer
m Bool -> Bool -> Bool
&& Integer -> Bool
isSmall52 Integer
r = JVal -> Maybe JVal
forall a. a -> Maybe a
Just (Integer -> JVal
JInt Integer
r)
| Bool
otherwise = Maybe JVal
forall a. Maybe a
Nothing
where
r :: Integer
r = Integer -> Integer -> Integer
op Integer
n Integer
m
getCmpOp :: Op -> Maybe (Integer -> Integer -> Bool)
getCmpOp :: Op -> Maybe (Integer -> Integer -> Bool)
getCmpOp Op
EqOp = (Integer -> Integer -> Bool) -> Maybe (Integer -> Integer -> Bool)
forall a. a -> Maybe a
Just Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
(==)
getCmpOp Op
StrictEqOp = (Integer -> Integer -> Bool) -> Maybe (Integer -> Integer -> Bool)
forall a. a -> Maybe a
Just Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
(==)
getCmpOp Op
NeqOp = (Integer -> Integer -> Bool) -> Maybe (Integer -> Integer -> Bool)
forall a. a -> Maybe a
Just Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
(/=)
getCmpOp Op
StrictNeqOp = (Integer -> Integer -> Bool) -> Maybe (Integer -> Integer -> Bool)
forall a. a -> Maybe a
Just Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
(/=)
getCmpOp Op
GtOp = (Integer -> Integer -> Bool) -> Maybe (Integer -> Integer -> Bool)
forall a. a -> Maybe a
Just Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(>)
getCmpOp Op
GeOp = (Integer -> Integer -> Bool) -> Maybe (Integer -> Integer -> Bool)
forall a. a -> Maybe a
Just Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(>=)
getCmpOp Op
LtOp = (Integer -> Integer -> Bool) -> Maybe (Integer -> Integer -> Bool)
forall a. a -> Maybe a
Just Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(<)
getCmpOp Op
LeOp = (Integer -> Integer -> Bool) -> Maybe (Integer -> Integer -> Bool)
forall a. a -> Maybe a
Just Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
getCmpOp Op
_ = Maybe (Integer -> Integer -> Bool)
forall a. Maybe a
Nothing
shiftOp :: (Int32 -> Int -> Int32) -> Integer -> Integer -> JVal
shiftOp :: (Int32 -> Int -> Int32) -> Integer -> Integer -> JVal
shiftOp Int32 -> Int -> Int32
op Integer
n Integer
m = Integer -> JVal
JInt (Integer -> JVal) -> Integer -> JVal
forall a b. (a -> b) -> a -> b
$ Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger
(Integer -> Int32
forall a. Num a => Integer -> a
fromInteger Integer
n Int32 -> Int -> Int32
`op` (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
m Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x1f))
truncOp :: (Int32 -> Int32 -> Int32) -> Integer -> Integer -> JVal
truncOp :: (Int32 -> Int32 -> Int32) -> Integer -> Integer -> JVal
truncOp Int32 -> Int32 -> Int32
op Integer
n Integer
m = Integer -> JVal
JInt (Integer -> JVal) -> Integer -> JVal
forall a b. (a -> b) -> a -> b
$ Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger
(Integer -> Int32
forall a. Num a => Integer -> a
fromInteger Integer
n Int32 -> Int32 -> Int32
`op` Integer -> Int32
forall a. Num a => Integer -> a
fromInteger Integer
m)
isSmall52 :: Integer -> Bool
isSmall52 :: Integer -> Bool
isSmall52 Integer
n = Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= -Integer
0x10000000000000 Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0xfffffffffffff
eqVal :: JVal -> JVal -> Bool
eqVal :: JVal -> JVal -> Bool
eqVal (JInt Integer
n1) (JInt Integer
n2) = Integer
n1 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
n2
eqVal (JStr FastString
s1) (JStr FastString
s2) = FastString
s1 FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== FastString
s2
eqVal (JBool Bool
b1) (JBool Bool
b2) = Bool
b1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
b2
eqVal (JDouble (SaneDouble Double
d1)) (JDouble (SaneDouble Double
d2))
| Bool -> Bool
not (Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
d1) Bool -> Bool -> Bool
&& Bool -> Bool
not (Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
d2) = Double
d1 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
d2
eqVal JVal
_ JVal
_ = Bool
False