module IR.Opt ( optIR ) where

import           Bits
import           Data.Bits (shiftL)
import           IR
import           Op

optIR :: [Stmt] -> [Stmt]
optIR :: [Stmt] -> [Stmt]
optIR = (Stmt -> Stmt) -> [Stmt] -> [Stmt]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stmt -> Stmt
opt

optE :: Exp -> Exp
optE :: Exp -> Exp
optE (IB IBin
ITimes Exp
e0 Exp
e1) =
    case (Exp -> Exp
optE Exp
e0, Exp -> Exp
optE Exp
e1) of
        (ConstI Int64
0, Exp
_)                             -> Int64 -> Exp
ConstI Int64
0
        (Exp
_, ConstI Int64
0)                             -> Int64 -> Exp
ConstI Int64
0
        (ConstI Int64
1, Exp
e1')                           -> Exp
e1'
        (Exp
e0', ConstI Int64
1)                           -> Exp
e0'
        (ConstI Int64
i0, ConstI Int64
i1)                    -> Int64 -> Exp
ConstI(Int64 -> Exp) -> Int64 -> Exp
forall a b. (a -> b) -> a -> b
$Int64
i0Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
i1
        (Exp
e0', ConstI Int64
i)        | Just Int64
s <- Int64 -> Maybe Int64
forall a. FiniteBits a => a -> Maybe Int64
cLog Int64
i -> IBin -> Exp -> Exp -> Exp
IB IBin
IAsl Exp
e0' (Int64 -> Exp
ConstI Int64
s)
        (ConstI Int64
i, Exp
e1')      | Just Int64
s <- Int64 -> Maybe Int64
forall a. FiniteBits a => a -> Maybe Int64
cLog Int64
i   -> IBin -> Exp -> Exp -> Exp
IB IBin
IAsl Exp
e1' (Int64 -> Exp
ConstI Int64
s)
        (Exp
e0', Exp
e1')                                -> IBin -> Exp -> Exp -> Exp
IB IBin
ITimes Exp
e0' Exp
e1'
optE (IB IBin
IPlus Exp
e0 Exp
e1) =
    case (Exp -> Exp
optE Exp
e0, Exp -> Exp
optE Exp
e1) of
        (ConstI Int64
0, Exp
e1')        -> Exp
e1'
        (Exp
e0', ConstI Int64
0)        -> Exp
e0'
        (ConstI Int64
i0, ConstI Int64
i1) -> Int64 -> Exp
ConstI(Int64 -> Exp) -> Int64 -> Exp
forall a b. (a -> b) -> a -> b
$Int64
i0Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
i1
        (Exp
e0', Exp
e1')             -> IBin -> Exp -> Exp -> Exp
IB IBin
IPlus Exp
e0' Exp
e1'
optE (IB IBin
IMinus Exp
e0 Exp
e1) =
    case (Exp -> Exp
optE Exp
e0, Exp -> Exp
optE Exp
e1) of
        (ConstI Int64
i0, ConstI Int64
i1) -> Int64 -> Exp
ConstI(Int64 -> Exp) -> Int64 -> Exp
forall a b. (a -> b) -> a -> b
$Int64
i0Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
-Int64
i1
        (Exp
e0', ConstI Int64
0)        -> Exp
e0'
        (Exp
e0', Exp
e1')             -> IBin -> Exp -> Exp -> Exp
IB IBin
IMinus Exp
e0' Exp
e1'
optE (IB IBin
IAsl Exp
e0 Exp
e1) =
    case (Exp -> Exp
optE Exp
e0, Exp -> Exp
optE Exp
e1) of
        (ConstI Int64
i0, ConstI Int64
i1) -> Int64 -> Exp
ConstI(Int64 -> Exp) -> Int64 -> Exp
forall a b. (a -> b) -> a -> b
$Int64
i0 Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftL` Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i1
        (Exp
e0', ConstI Int64
0)        -> Exp
e0'
        (Exp
e0',Exp
e1')              -> IBin -> Exp -> Exp -> Exp
IB IBin
IAsl Exp
e0' Exp
e1'
optE (IB IBin
op Exp
e Exp
e')            = IBin -> Exp -> Exp -> Exp
IB IBin
op (Exp -> Exp
optE Exp
e) (Exp -> Exp
optE Exp
e')
optE (IRel IRel
rel Exp
e Exp
e')         = IRel -> Exp -> Exp -> Exp
IRel IRel
rel (Exp -> Exp
optE Exp
e) (Exp -> Exp
optE Exp
e')
optE (FRel FRel
rel FExp
fe FExp
fe')       = FRel -> FExp -> FExp -> Exp
FRel FRel
rel (FExp -> FExp
optF FExp
fe) (FExp -> FExp
optF FExp
fe')
optE (IU IUn
u Exp
e)                = IUn -> Exp -> Exp
IU IUn
u (Exp -> Exp
optE Exp
e)
optE (IRFloor FExp
fe)            = FExp -> Exp
IRFloor (FExp -> FExp
optF FExp
fe)
optE (EAt AE
p)                 = AE -> Exp
EAt (AE -> AE
optP AE
p)
optE (BAt AE
p)                 = AE -> Exp
BAt (AE -> AE
optP AE
p)
optE Exp
e                       = Exp
e

optF :: FExp -> FExp
optF :: FExp -> FExp
optF (FAt AE
p) = AE -> FExp
FAt (AE -> AE
optP AE
p)
optF (FConv Exp
e) =
    case Exp -> Exp
optE Exp
e of
        ConstI Int64
i -> Double -> FExp
ConstF(Double -> FExp) -> Double -> FExp
forall a b. (a -> b) -> a -> b
$Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
        Exp
e'       -> Exp -> FExp
FConv Exp
e'
optF (FU FUn
FLog FExp
e) =
    case FExp -> FExp
optF FExp
e of
        ConstF Double
d -> Double -> FExp
ConstF(Double -> FExp) -> Double -> FExp
forall a b. (a -> b) -> a -> b
$Double -> Double
forall a. Floating a => a -> a
log Double
d
        FExp
e'       -> FUn -> FExp -> FExp
FU FUn
FLog FExp
e'
optF (FB FBin
FMinus FExp
e0 FExp
e1) =
    case (FExp -> FExp
optF FExp
e0, FExp -> FExp
optF FExp
e1) of
        (FExp
e0', ConstF Double
0) -> FExp
e0'
        (FExp
e0', FExp
e1')      -> FBin -> FExp -> FExp -> FExp
FB FBin
FMinus FExp
e0' FExp
e1'
optF (FB FBin
FPlus FExp
e0 FExp
e1) =
    case (FExp -> FExp
optF FExp
e0, FExp -> FExp
optF FExp
e1) of
        (ConstF Double
0, FExp
e1')        -> FExp
e1'
        (FExp
e0', ConstF Double
0)        -> FExp
e0'
        (ConstF Double
x0, ConstF Double
x1) -> Double -> FExp
ConstF(Double -> FExp) -> Double -> FExp
forall a b. (a -> b) -> a -> b
$Double
x0Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
x1
        (FExp
e0',FExp
e1')              -> FBin -> FExp -> FExp -> FExp
FB FBin
FPlus FExp
e0' FExp
e1'
optF (FB FBin
FTimes FExp
e0 FExp
e1) =
    case (FExp -> FExp
optF FExp
e0, FExp -> FExp
optF FExp
e1) of
        (ConstF Double
1, FExp
e1')        -> FExp
e1'
        (FExp
e0', ConstF Double
1)        -> FExp
e0'
        (ConstF Double
x0, ConstF Double
x1) -> Double -> FExp
ConstF(Double -> FExp) -> Double -> FExp
forall a b. (a -> b) -> a -> b
$Double
x0Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
x1
        (FExp
e0',FExp
e1')              -> FBin -> FExp -> FExp -> FExp
FB FBin
FTimes FExp
e0' FExp
e1'
optF (FB FBin
FDiv FExp
e0 FExp
e1) =
    case (FExp -> FExp
optF FExp
e0, FExp -> FExp
optF FExp
e1) of
        (FExp
e0', ConstF Double
1)        -> FExp
e0'
        (ConstF Double
x0, ConstF Double
x1) -> Double -> FExp
ConstF(Double -> FExp) -> Double -> FExp
forall a b. (a -> b) -> a -> b
$Double
x0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
x1
        (FExp
e0', ConstF Double
x)        -> FBin -> FExp -> FExp -> FExp
FB FBin
FTimes FExp
e0' (Double -> FExp
ConstF(Double -> FExp) -> Double -> FExp
forall a b. (a -> b) -> a -> b
$Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
x)
        (FExp
e0',FExp
e1')              -> FBin -> FExp -> FExp -> FExp
FB FBin
FDiv FExp
e0' FExp
e1'
optF FExp
fe      = FExp
fe

optP :: AE -> AE
optP :: AE -> AE
optP (AP Temp
t Maybe Exp
me Maybe AL
l) = Temp -> Maybe Exp -> Maybe AL -> AE
AP Temp
t ((Exp -> Exp) -> Maybe Exp -> Maybe Exp
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp -> Exp
optE Maybe Exp
me) Maybe AL
l

opt :: Stmt -> Stmt
opt :: Stmt -> Stmt
opt (Cpy AE
s AE
d Exp
n)   = AE -> AE -> Exp -> Stmt
Cpy (AE -> AE
optP AE
s) (AE -> AE
optP AE
d) (Exp -> Exp
optE Exp
n)
opt (Cpy1 AE
s AE
d Exp
n)  = AE -> AE -> Exp -> Stmt
Cpy1 (AE -> AE
optP AE
s) (AE -> AE
optP AE
d) (Exp -> Exp
optE Exp
n)
opt (MT Temp
r Exp
e)      = Temp -> Exp -> Stmt
MT Temp
r (Exp -> Exp
optE Exp
e)
opt (Ma AL
l Temp
t Exp
e)    = AL -> Temp -> Exp -> Stmt
Ma AL
l Temp
t (Exp -> Exp
optE Exp
e)
opt (Wr AE
p Exp
e)      = AE -> Exp -> Stmt
Wr (AE -> AE
optP AE
p) (Exp -> Exp
optE Exp
e)
opt (WrF AE
p FExp
e)     = AE -> FExp -> Stmt
WrF (AE -> AE
optP AE
p) (FExp -> FExp
optF FExp
e)
opt (WrB AE
p Exp
e)     = AE -> Exp -> Stmt
WrB (AE -> AE
optP AE
p) (Exp -> Exp
optE Exp
e)
opt (MX FTemp
xr FExp
e)     = FTemp -> FExp -> Stmt
MX FTemp
xr (FExp -> FExp
optF FExp
e)
opt (Cmov Exp
e Temp
t Exp
e') = Exp -> Temp -> Exp -> Stmt
Cmov (Exp -> Exp
optE Exp
e) Temp
t (Exp -> Exp
optE Exp
e')
opt (MJ Exp
e Label
l)      = Exp -> Label -> Stmt
MJ (Exp -> Exp
optE Exp
e) Label
l
opt Stmt
s             = Stmt
s