module IR.C ( ctemp, cToIR ) where

import           Bits
import           C
import           Control.Monad              (foldM)
import           Control.Monad.State.Strict (State, runState, state)
import           IR
import           Op

type IRM = State WSt

nextI :: IRM C.Temp
nextI :: IRM Temp
nextI = Int -> Temp
C.ITemp (Int -> Temp) -> StateT WSt Identity Int -> IRM Temp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WSt -> (Int, WSt)) -> StateT WSt Identity Int
forall a. (WSt -> (a, WSt)) -> StateT WSt Identity a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (\(WSt Label
ls Int
t) -> (Int
t, Label -> Int -> WSt
WSt Label
ls (Int
tInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)))

nextL :: IRM IR.Label
nextL :: IRM Label
nextL = (WSt -> (Label, WSt)) -> IRM Label
forall a. (WSt -> (a, WSt)) -> StateT WSt Identity a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (\(WSt Label
l Int
ts) -> (Label
l, Label -> Int -> WSt
WSt (Label
lLabel -> Label -> Label
forall a. Num a => a -> a -> a
+Label
1) Int
ts))

cbtemp :: C.BTemp -> IR.Temp
cbtemp :: BTemp -> Temp
cbtemp (C.BTemp Int
i) = Int -> Temp
IR.ITemp Int
i; cbtemp BTemp
C.CBRet = Temp
IR.CRet

ctemp :: C.Temp -> IR.Temp
ctemp :: Temp -> Temp
ctemp (C.ATemp Int
i) = Int -> Temp
IR.ATemp Int
i; ctemp (C.ITemp Int
i) = Int -> Temp
IR.ITemp Int
i
ctemp Temp
C.C0 = Temp
IR.C0; ctemp Temp
C.C1 = Temp
IR.C1; ctemp Temp
C.C2 = Temp
IR.C2
ctemp Temp
C.C3 = Temp
IR.C3; ctemp Temp
C.C4 = Temp
IR.C4; ctemp Temp
C.C5 = Temp
IR.C5
ctemp Temp
C.CRet = Temp
IR.CRet

fx :: C.FTemp -> IR.FTemp
fx :: FTemp -> FTemp
fx (C.FTemp Int
i) = Int -> FTemp
IR.FTemp Int
i
fx FTemp
FRet0 = FTemp
FRet; fx FTemp
C.FRet1 = FTemp
IR.FRet1
fx FTemp
C.F0 = FTemp
IR.F0; fx FTemp
C.F1 = FTemp
IR.F1; fx FTemp
C.F2 = FTemp
IR.F2
fx FTemp
C.F3 = FTemp
IR.F3; fx FTemp
C.F4 = FTemp
IR.F4; fx FTemp
C.F5 = FTemp
IR.F5

cToIR :: LSt -> [CS a] -> ([Stmt], WSt)
cToIR :: forall a. LSt -> [CS a] -> ([Stmt], WSt)
cToIR (LSt Label
ls Int
ts) [CS a]
cs = State WSt [Stmt] -> WSt -> ([Stmt], WSt)
forall s a. State s a -> s -> (a, s)
runState ((CS a -> State WSt [Stmt]) -> [CS a] -> State WSt [Stmt]
forall {t :: * -> *} {m :: * -> *} {b} {t}.
(Foldable t, Monad m, Monoid b) =>
(t -> m b) -> t t -> m b
foldMapM CS a -> State WSt [Stmt]
forall a. CS a -> State WSt [Stmt]
cToIRM [CS a]
cs) (Label -> Int -> WSt
WSt Label
ls Int
ts)

tick :: Temp -> Stmt
tick Temp
reg = Temp -> Exp -> Stmt
IR.MT Temp
reg (Temp -> Exp
Reg Temp
regExp -> Exp -> Exp
forall a. Num a => a -> a -> a
+Exp
1)

nr :: IRel -> IRel
nr IRel
IGeq=IRel
ILt; nr IRel
IGt=IRel
ILeq; nr IRel
ILt=IRel
IGeq; nr IRel
ILeq=IRel
IGt; nr IRel
IEq=IRel
INeq; nr IRel
INeq=IRel
IEq

cToIRM :: CS a -> IRM [Stmt]
cToIRM :: forall a. CS a -> State WSt [Stmt]
cToIRM (G a
_ Label
l Label
retL)          = [Stmt] -> State WSt [Stmt]
forall a. a -> StateT WSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Label -> Stmt
IR.C Label
l, Label -> Stmt
IR.L Label
retL]
-- FIXME: put this at the end so it doesn't have to be skipped
cToIRM (Def a
_ Label
l [CS a]
cs)          = do
    endL <- IRM Label
nextL
    irs <- foldMapM cToIRM cs
    pure (J endL:L l:irs++[IR.R l, L endL])
cToIRM (C.PlProd a
_ Temp
t (CE
e:[CE]
es)) = let t' :: Temp
t' = Temp -> Temp
ctemp Temp
t in [Stmt] -> State WSt [Stmt]
forall a. a -> StateT WSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Temp -> Exp -> Stmt
IR.MT Temp
t' (CE -> Exp
irE CE
e)Stmt -> [Stmt] -> [Stmt]
forall a. a -> [a] -> [a]
:[Temp -> Exp -> Stmt
IR.MT Temp
t' (Temp -> Exp
IR.Reg Temp
t'Exp -> Exp -> Exp
forall a. Num a => a -> a -> a
*CE -> Exp
irE CE
eϵ) | CE
eϵ <- [CE]
es])
cToIRM (C.MT a
_ Temp
t CE
e)        = [Stmt] -> State WSt [Stmt]
forall a. a -> StateT WSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Temp -> Exp -> Stmt
IR.MT (Temp -> Temp
ctemp Temp
t) (CE -> Exp
irE CE
e)]
cToIRM (C.MX a
_ FTemp
t CFE FTemp Double CE
e)          = [Stmt] -> State WSt [Stmt]
forall a. a -> StateT WSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FTemp -> FExp -> Stmt
IR.MX (FTemp -> FTemp
fx FTemp
t) (CFE FTemp Double CE -> FExp
irX CFE FTemp Double CE
e)]
cToIRM (C.MB a
_ BTemp
t PE
e)          = [Stmt] -> State WSt [Stmt]
forall a. a -> StateT WSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Temp -> Exp -> Stmt
IR.MT (BTemp -> Temp
cbtemp BTemp
t) (PE -> Exp
irp PE
e)]
cToIRM (Rnd a
_ Temp
t)             = [Stmt] -> State WSt [Stmt]
forall a. a -> StateT WSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Temp -> Stmt
IR.IRnd (Temp -> Temp
ctemp Temp
t)]
cToIRM (C.FRnd a
_ FTemp
t)          = [Stmt] -> State WSt [Stmt]
forall a. a -> StateT WSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FTemp -> Stmt
IR.FRnd (FTemp -> FTemp
fx FTemp
t)]
cToIRM (C.Ma a
_ AL
l Temp
t (C.ConstI Int64
rnkI) CE
n Int64
sz) | Just Int64
s <- Int64 -> Maybe Int64
forall a. FiniteBits a => a -> Maybe Int64
cLog Int64
sz = let t' :: Temp
t'=Temp -> Temp
ctemp Temp
t in [Stmt] -> State WSt [Stmt]
forall a. a -> StateT WSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [AL -> Temp -> Exp -> Stmt
IR.Ma AL
l Temp
t' (IBin -> Exp -> Exp -> Exp
IR.IB IBin
IAsl (CE -> Exp
irE CE
n) (Int64 -> Exp
IR.ConstI Int64
s)Exp -> Exp -> Exp
forall a. Num a => a -> a -> a
+Int64 -> Exp
IR.ConstI (Int64
8Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
8Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
rnkI)), AE -> Exp -> Stmt
IR.Wr (Temp -> Maybe Exp -> Maybe AL -> AE
AP Temp
t' Maybe Exp
forall a. Maybe a
Nothing (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
l)) (Int64 -> Exp
IR.ConstI Int64
rnkI)]
-- TODO: allocate rnk `shiftL` 3 for dims
cToIRM (C.Ma a
_ AL
l Temp
t CE
rnk CE
n Int64
sz) | Just Int64
s <- Int64 -> Maybe Int64
forall a. FiniteBits a => a -> Maybe Int64
cLog Int64
sz = let t' :: Temp
t'=Temp -> Temp
ctemp Temp
t in [Stmt] -> State WSt [Stmt]
forall a. a -> StateT WSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [AL -> Temp -> Exp -> Stmt
IR.Ma AL
l Temp
t' (IBin -> Exp -> Exp -> Exp
IR.IB IBin
IAsl (CE -> Exp
irE CE
rnkExp -> Exp -> Exp
forall a. Num a => a -> a -> a
+CE -> Exp
irE CE
n) (Int64 -> Exp
IR.ConstI Int64
s)Exp -> Exp -> Exp
forall a. Num a => a -> a -> a
+Exp
8), AE -> Exp -> Stmt
IR.Wr (Temp -> Maybe Exp -> Maybe AL -> AE
AP Temp
t' Maybe Exp
forall a. Maybe a
Nothing (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
l)) (CE -> Exp
irE CE
rnk)]
-- TODO: allocate rnk `shiftL` 3 for dims
cToIRM (C.Ma a
_ AL
l Temp
t CE
rnk CE
n Int64
sz) = let t' :: Temp
t'=Temp -> Temp
ctemp Temp
t in [Stmt] -> State WSt [Stmt]
forall a. a -> StateT WSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [AL -> Temp -> Exp -> Stmt
IR.Ma AL
l Temp
t' ((CE -> Exp
irE CE
rnkExp -> Exp -> Exp
forall a. Num a => a -> a -> a
+CE -> Exp
irE CE
n)Exp -> Exp -> Exp
forall a. Num a => a -> a -> a
*Int64 -> Exp
IR.ConstI Int64
szExp -> Exp -> Exp
forall a. Num a => a -> a -> a
+Exp
8), AE -> Exp -> Stmt
IR.Wr (Temp -> Maybe Exp -> Maybe AL -> AE
AP Temp
t' Maybe Exp
forall a. Maybe a
Nothing (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
l)) (CE -> Exp
irE CE
rnk)]
cToIRM (C.MaΠ a
_ AL
l Temp
t CE
sz)      = [Stmt] -> State WSt [Stmt]
forall a. a -> StateT WSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [AL -> Temp -> Exp -> Stmt
IR.Ma AL
l (Temp -> Temp
ctemp Temp
t) (CE -> Exp
irE CE
sz)]
cToIRM (C.Free Temp
t)            = [Stmt] -> State WSt [Stmt]
forall a. a -> StateT WSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Temp -> Stmt
IR.Free (Temp -> Temp
ctemp Temp
t)]
cToIRM (C.Wr a
_ ArrAcc
a CE
e)          = [Stmt] -> State WSt [Stmt]
forall a. a -> StateT WSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [AE -> Exp -> Stmt
IR.Wr (ArrAcc -> AE
irAt ArrAcc
a) (CE -> Exp
irE CE
e)]
cToIRM (C.WrF a
_ ArrAcc
a CFE FTemp Double CE
x)         = [Stmt] -> State WSt [Stmt]
forall a. a -> StateT WSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [AE -> FExp -> Stmt
IR.WrF (ArrAcc -> AE
irAt ArrAcc
a) (CFE FTemp Double CE -> FExp
irX CFE FTemp Double CE
x)]
cToIRM (C.WrP a
_ ArrAcc
a PE
b)         = [Stmt] -> State WSt [Stmt]
forall a. a -> StateT WSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [AE -> Exp -> Stmt
IR.WrB (ArrAcc -> AE
irAt ArrAcc
a) (PE -> Exp
irp PE
b)]
cToIRM (For a
_ Temp
t CE
el IRel
rel CE
eu [CS a]
s) = do
    l <- IRM Label
nextL; eL <- nextL
    irs <- foldMapM cToIRM s
    pure $ IR.MT t' (irE el):MJ (IR.IRel (nr rel) (Reg t') (irE eu)) eL:L l:irs++[tick t', MJ (IR.IRel rel (Reg t') (irE eu)) l, L eL]
  where
    t' :: Temp
t'=Temp -> Temp
ctemp Temp
t
cToIRM (For1 a
_ Temp
t CE
el IRel
rel CE
eu [CS a]
s) = do
    l <- IRM Label
nextL
    irs <- foldMapM cToIRM s
    pure $ IR.MT t' (irE el):L l:irs++[tick t', MJ (IR.IRel rel (Reg t') (irE eu)) l]
  where
    t' :: Temp
t'=Temp -> Temp
ctemp Temp
t
cToIRM (While a
_ Temp
t IRel
rel CE
eb [CS a]
s) = do
    l <- IRM Label
nextL; eL <- nextL
    s' <- foldMapM cToIRM s
    pure $ MJ (IR.IRel (nr rel) (Reg t') (irE eb)) eL:L l:s'++[MJ (IR.IRel rel (Reg t') (irE eb)) l, L eL]
  where t' :: Temp
t'=Temp -> Temp
ctemp Temp
t
cToIRM (WT a
_ PE
p [CS a]
s) = do
    l <- IRM Label
nextL; eL <- nextL
    s' <- foldMapM cToIRM s
    pure $ MJ (IR.BU BNeg p') eL:L l:s'++[MJ p' l, L eL]
  where p' :: Exp
p'=PE -> Exp
irp PE
p
cToIRM (C.RA a
_ AL
i) = [Stmt] -> State WSt [Stmt]
forall a. a -> StateT WSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [AL -> Stmt
IR.RA AL
i]
cToIRM (CpyD a
_ ArrAcc
a0 ArrAcc
a1 CE
e) = [Stmt] -> State WSt [Stmt]
forall a. a -> StateT WSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [AE -> AE -> Exp -> Stmt
Cpy (ArrAcc -> AE
irAt ArrAcc
a0) (ArrAcc -> AE
irAt ArrAcc
a1) (CE -> Exp
irE CE
e)]
cToIRM (CpyE a
_ ArrAcc
a0 ArrAcc
a1 CE
e Int64
8) = [Stmt] -> State WSt [Stmt]
forall a. a -> StateT WSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [AE -> AE -> Exp -> Stmt
Cpy (ArrAcc -> AE
irAt ArrAcc
a0) (ArrAcc -> AE
irAt ArrAcc
a1) (CE -> Exp
irE CE
e)]
cToIRM (CpyE a
_ ArrAcc
a0 ArrAcc
a1 CE
e Int64
sz) | (Int64
s,Int64
0) <- Int64
sz Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
8 = [Stmt] -> State WSt [Stmt]
forall a. a -> StateT WSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [AE -> AE -> Exp -> Stmt
Cpy (ArrAcc -> AE
irAt ArrAcc
a0) (ArrAcc -> AE
irAt ArrAcc
a1) (CE -> Exp
irE CE
eExp -> Exp -> Exp
forall a. Num a => a -> a -> a
*Int64 -> Exp
IR.ConstI Int64
s)]
cToIRM (CpyE a
_ ArrAcc
a0 ArrAcc
a1 CE
e Int64
sz) = [Stmt] -> State WSt [Stmt]
forall a. a -> StateT WSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [AE -> AE -> Exp -> Stmt
Cpy1 (ArrAcc -> AE
irAt ArrAcc
a0) (ArrAcc -> AE
irAt ArrAcc
a1) (CE -> Exp
irE CE
eExp -> Exp -> Exp
forall a. Num a => a -> a -> a
*Int64 -> Exp
IR.ConstI Int64
sz)]
cToIRM (C.Sa a
_ Temp
t CE
e) = [Stmt] -> State WSt [Stmt]
forall a. a -> StateT WSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Temp -> Exp -> Stmt
IR.Sa (Temp -> Temp
ctemp Temp
t) (CE -> Exp
irE CE
e)]
cToIRM (C.Pop a
_ CE
e) = [Stmt] -> State WSt [Stmt]
forall a. a -> StateT WSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Exp -> Stmt
IR.Pop (CE -> Exp
irE CE
e)]
cToIRM (Ifn't a
_ PE
p [CS a]
s) = do
    l <- IRM Label
nextL
    s' <- foldMapM cToIRM s
    pure $ MJ (irp p) l:s'++[L l]
cToIRM (If a
_ PE
p [CS a]
s0 [CS a]
s1) = do
    l <- IRM Label
nextL; l' <- nextL
    s0' <- foldMapM cToIRM s0; s1' <- foldMapM cToIRM s1
    pure $ MJ (irp p) l:s1'++J l':L l:s0'++[L l']
cToIRM (C.Cmov a
_ PE
p Temp
t CE
e) = [Stmt] -> State WSt [Stmt]
forall a. a -> StateT WSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Exp -> Temp -> Exp -> Stmt
IR.Cmov (PE -> Exp
irp PE
p) (Temp -> Temp
ctemp Temp
t) (CE -> Exp
irE CE
e)]
cToIRM (C.Fcmov a
_ PE
p FTemp
t CFE FTemp Double CE
e) = [Stmt] -> State WSt [Stmt]
forall a. a -> StateT WSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Exp -> FTemp -> FExp -> Stmt
IR.Fcmov (PE -> Exp
irp PE
p) (FTemp -> FTemp
fx FTemp
t) (CFE FTemp Double CE -> FExp
irX CFE FTemp Double CE
e)]
cToIRM (C.Cset a
_ PE
p BTemp
t) = [Stmt] -> State WSt [Stmt]
forall a. a -> StateT WSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Temp -> Exp -> Stmt
IR.Cset (BTemp -> Temp
cbtemp BTemp
t) (PE -> Exp
irp PE
p)]
cToIRM (SZ a
_ Temp
td Temp
t CE
rnk Maybe AL
l) = do
    i <- IRM Temp
nextI
    foldMapM cToIRM
        [td =: C.EAt (ADim t 0 l), For () i 1 ILt rnk [td =: (Tmp td*C.EAt (ADim t (Tmp i) l))]]

irAt :: ArrAcc -> AE
irAt :: ArrAcc -> AE
irAt (ARnk Temp
t Maybe AL
l)                                                = Temp -> Maybe Exp -> Maybe AL -> AE
AP (Temp -> Temp
ctemp Temp
t) Maybe Exp
forall a. Maybe a
Nothing Maybe AL
l
irAt (ADim Temp
t (C.ConstI Int64
n) Maybe AL
l)                                   = Temp -> Maybe Exp -> Maybe AL -> AE
AP (Temp -> Temp
ctemp Temp
t) (Exp -> Maybe Exp
forall a. a -> Maybe a
Just(Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$Int64 -> Exp
IR.ConstI (Int64
8Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
8Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
n)) Maybe AL
l
irAt (ADim Temp
t CE
e Maybe AL
l)                                              = Temp -> Maybe Exp -> Maybe AL -> AE
AP (Temp -> Temp
ctemp Temp
t) (Exp -> Maybe Exp
forall a. a -> Maybe a
Just(Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$IBin -> Exp -> Exp -> Exp
IR.IB IBin
IAsl (CE -> Exp
irE CE
e) Exp
3Exp -> Exp -> Exp
forall a. Num a => a -> a -> a
+Exp
8) Maybe AL
l
irAt (AElem Temp
t (C.ConstI Int64
1) (C.ConstI Int64
0) Maybe AL
l Int64
_)                   = Temp -> Maybe Exp -> Maybe AL -> AE
AP (Temp -> Temp
ctemp Temp
t) (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
16) Maybe AL
l
irAt (AElem Temp
t (C.ConstI Int64
rnkI) (Bin IBin
IPlus CE
e (C.ConstI Int64
n)) Maybe AL
l Int64
8)  = Temp -> Maybe Exp -> Maybe AL -> AE
AP (Temp -> Temp
ctemp Temp
t) (Exp -> Maybe Exp
forall a. a -> Maybe a
Just(Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$IBin -> Exp -> Exp -> Exp
IR.IB IBin
IAsl (CE -> Exp
irE CE
e) Exp
3Exp -> Exp -> Exp
forall a. Num a => a -> a -> a
+Int64 -> Exp
IR.ConstI (Int64
8Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
8Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*(Int64
rnkIInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
n))) Maybe AL
l
irAt (AElem Temp
t (C.ConstI Int64
rnkI) (Bin IBin
IMinus CE
e (C.ConstI Int64
n)) Maybe AL
l Int64
8) = Temp -> Maybe Exp -> Maybe AL -> AE
AP (Temp -> Temp
ctemp Temp
t) (Exp -> Maybe Exp
forall a. a -> Maybe a
Just(Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$IBin -> Exp -> Exp -> Exp
IR.IB IBin
IAsl (CE -> Exp
irE CE
e) Exp
3Exp -> Exp -> Exp
forall a. Num a => a -> a -> a
+Int64 -> Exp
IR.ConstI (Int64
8Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
8Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*(Int64
rnkIInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
-Int64
n))) Maybe AL
l
irAt (AElem Temp
t (C.ConstI Int64
rnkI) CE
e Maybe AL
l Int64
sz) | Just Int64
s <- Int64 -> Maybe Int64
forall a. FiniteBits a => a -> Maybe Int64
cLog Int64
sz      = Temp -> Maybe Exp -> Maybe AL -> AE
AP (Temp -> Temp
ctemp Temp
t) (Exp -> Maybe Exp
forall a. a -> Maybe a
Just(Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$IBin -> Exp -> Exp -> Exp
IR.IB IBin
IAsl (CE -> Exp
irE CE
e) (Int64 -> Exp
IR.ConstI Int64
s)Exp -> Exp -> Exp
forall a. Num a => a -> a -> a
+Int64 -> Exp
IR.ConstI (Int64
8Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
8Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
rnkI)) Maybe AL
l
                                      | Bool
otherwise              = Temp -> Maybe Exp -> Maybe AL -> AE
AP (Temp -> Temp
ctemp Temp
t) (Exp -> Maybe Exp
forall a. a -> Maybe a
Just(Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$(CE -> Exp
irE CE
eExp -> Exp -> Exp
forall a. Num a => a -> a -> a
*Int64 -> Exp
IR.ConstI Int64
sz)Exp -> Exp -> Exp
forall a. Num a => a -> a -> a
+Int64 -> Exp
IR.ConstI (Int64
8Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
8Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
rnkI)) Maybe AL
l
irAt (AElem Temp
t CE
rnk CE
e Maybe AL
l Int64
8)                                       = Temp -> Maybe Exp -> Maybe AL -> AE
AP (Temp -> Temp
ctemp Temp
t) (Exp -> Maybe Exp
forall a. a -> Maybe a
Just(Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$IBin -> Exp -> Exp -> Exp
IR.IB IBin
IAsl (CE -> Exp
irE CE
rnkExp -> Exp -> Exp
forall a. Num a => a -> a -> a
+CE -> Exp
irE CE
e) Exp
3Exp -> Exp -> Exp
forall a. Num a => a -> a -> a
+Exp
8) Maybe AL
l
irAt (AElem Temp
t CE
rnk CE
e Maybe AL
l Int64
sz) | Just Int64
s <- Int64 -> Maybe Int64
forall a. FiniteBits a => a -> Maybe Int64
cLog Int64
sz                  = Temp -> Maybe Exp -> Maybe AL -> AE
AP (Temp -> Temp
ctemp Temp
t) (Exp -> Maybe Exp
forall a. a -> Maybe a
Just(Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$IBin -> Exp -> Exp -> Exp
IR.IB IBin
IAsl (CE -> Exp
irE CE
rnk) Exp
3Exp -> Exp -> Exp
forall a. Num a => a -> a -> a
+IBin -> Exp -> Exp -> Exp
IR.IB IBin
IAsl (CE -> Exp
irE CE
e) (Int64 -> Exp
IR.ConstI Int64
s)Exp -> Exp -> Exp
forall a. Num a => a -> a -> a
+Exp
8) Maybe AL
l
                          | Bool
otherwise                          = Temp -> Maybe Exp -> Maybe AL -> AE
AP (Temp -> Temp
ctemp Temp
t) (Exp -> Maybe Exp
forall a. a -> Maybe a
Just(Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$IBin -> Exp -> Exp -> Exp
IR.IB IBin
IAsl (CE -> Exp
irE CE
rnk) Exp
3Exp -> Exp -> Exp
forall a. Num a => a -> a -> a
+(CE -> Exp
irE CE
eExp -> Exp -> Exp
forall a. Num a => a -> a -> a
*Int64 -> Exp
IR.ConstI Int64
sz)Exp -> Exp -> Exp
forall a. Num a => a -> a -> a
+Exp
8) Maybe AL
l
irAt (TupM Temp
t Maybe AL
l)                                                = Temp -> Maybe Exp -> Maybe AL -> AE
AP (Temp -> Temp
ctemp Temp
t) Maybe Exp
forall a. Maybe a
Nothing Maybe AL
l
irAt (Raw Temp
t (C.ConstI Int64
0) Maybe AL
l Int64
_)                                  = Temp -> Maybe Exp -> Maybe AL -> AE
AP (Temp -> Temp
ctemp Temp
t) Maybe Exp
forall a. Maybe a
Nothing Maybe AL
l
irAt (Raw Temp
t (C.ConstI Int64
i) Maybe AL
l Int64
sz)                                 = Temp -> Maybe Exp -> Maybe AL -> AE
AP (Temp -> Temp
ctemp Temp
t) (Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Int64 -> Exp
IR.ConstI(Int64 -> Exp) -> Int64 -> Exp
forall a b. (a -> b) -> a -> b
$Int64
iInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
sz)) Maybe AL
l
irAt (Raw Temp
t CE
o Maybe AL
l Int64
1)                                             = Temp -> Maybe Exp -> Maybe AL -> AE
AP (Temp -> Temp
ctemp Temp
t) (Exp -> Maybe Exp
forall a. a -> Maybe a
Just(Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$CE -> Exp
irE CE
o) Maybe AL
l
irAt (Raw Temp
t CE
o Maybe AL
l Int64
sz) | Just Int64
n <- Int64 -> Maybe Int64
forall a. FiniteBits a => a -> Maybe Int64
cLog Int64
sz                        = Temp -> Maybe Exp -> Maybe AL -> AE
AP (Temp -> Temp
ctemp Temp
t) (Exp -> Maybe Exp
forall a. a -> Maybe a
Just(Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$IBin -> Exp -> Exp -> Exp
IR.IB IBin
IAsl (CE -> Exp
irE CE
o) (Int64 -> Exp
IR.ConstI Int64
n)) Maybe AL
l
                    | Bool
otherwise                                = Temp -> Maybe Exp -> Maybe AL -> AE
AP (Temp -> Temp
ctemp Temp
t) (Exp -> Maybe Exp
forall a. a -> Maybe a
Just(Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$CE -> Exp
irE CE
oExp -> Exp -> Exp
forall a. Num a => a -> a -> a
*Int64 -> Exp
IR.ConstI Int64
sz) Maybe AL
l
irAt (At Temp
dt [CE]
s [CE]
ix Maybe AL
l Int64
sz) | Just Int64
sϵ <- Int64 -> Maybe Int64
forall a. FiniteBits a => a -> Maybe Int64
cLog Int64
sz =
    let offs :: Exp
offs=(Exp -> Exp -> Exp) -> [Exp] -> Exp
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (IBin -> Exp -> Exp -> Exp
IB IBin
IPlus) ([Exp] -> Exp) -> [Exp] -> Exp
forall a b. (a -> b) -> a -> b
$ (CE -> CE -> Exp) -> [CE] -> [CE] -> [Exp]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\CE
d CE
i -> Exp -> Exp -> Exp
sm (CE -> Exp
irE CE
i) (CE -> Exp
irE CE
d)) [CE]
s [CE]
ix
    in Temp -> Maybe Exp -> Maybe AL -> AE
AP (Temp -> Temp
ctemp Temp
dt) (Exp -> Maybe Exp
forall a. a -> Maybe a
Just(Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$IBin -> Exp -> Exp -> Exp
IR.IB IBin
IAsl Exp
offs (Int64 -> Exp
IR.ConstI Int64
sϵ)) Maybe AL
l
  where
    sm :: Exp -> Exp -> Exp
sm Exp
i (IR.ConstI Int64
1) = Exp
i
    sm Exp
i (IR.ConstI Int64
d) | Just Int64
sϵ <- Int64 -> Maybe Int64
forall a. FiniteBits a => a -> Maybe Int64
cLog Int64
d = IBin -> Exp -> Exp -> Exp
IR.IB IBin
IAsl Exp
i (Int64 -> Exp
IR.ConstI Int64
sϵ)
    sm Exp
d Exp
i = Exp
iExp -> Exp -> Exp
forall a. Num a => a -> a -> a
*Exp
d

irE :: CE -> Exp
irE :: CE -> Exp
irE (Tmp Temp
t)               = Temp -> Exp
Reg (Temp -> Temp
ctemp Temp
t)
irE (C.EAt ArrAcc
a)             = AE -> Exp
IR.EAt (ArrAcc -> AE
irAt ArrAcc
a)
irE (C.ConstI Int64
i)          = Int64 -> Exp
IR.ConstI Int64
i
irE (Bin IBin
op CE
e0 CE
e1)        = IBin -> Exp -> Exp -> Exp
IB IBin
op (CE -> Exp
irE CE
e0) (CE -> Exp
irE CE
e1)
irE (C.LA Int
i)              = Int -> Exp
IR.LA Int
i
irE (DP Temp
t (C.ConstI Int64
rnk)) = Temp -> Exp
Reg (Temp -> Temp
ctemp Temp
t)Exp -> Exp -> Exp
forall a. Num a => a -> a -> a
+Int64 -> Exp
IR.ConstI (Int64
8Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*(Int64
1Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
rnk))
irE (DP Temp
t CE
e)              = Temp -> Exp
Reg (Temp -> Temp
ctemp Temp
t)Exp -> Exp -> Exp
forall a. Num a => a -> a -> a
+IBin -> Exp -> Exp -> Exp
IB IBin
IAsl (CE -> Exp
irE CE
e) Exp
3Exp -> Exp -> Exp
forall a. Num a => a -> a -> a
+Exp
8
irE (CFloor CFE FTemp Double CE
e)            = FExp -> Exp
IRFloor (CFE FTemp Double CE -> FExp
irX CFE FTemp Double CE
e)

irp :: PE -> Exp
irp :: PE -> Exp
irp (C.IRel IRel
rel CE
e0 CE
e1) = IRel -> Exp -> Exp -> Exp
IR.IRel IRel
rel (CE -> Exp
irE CE
e0) (CE -> Exp
irE CE
e1)
irp (C.FRel FRel
rel CFE FTemp Double CE
x0 CFE FTemp Double CE
x1) = FRel -> FExp -> FExp -> Exp
IR.FRel FRel
rel (CFE FTemp Double CE -> FExp
irX CFE FTemp Double CE
x0) (CFE FTemp Double CE -> FExp
irX CFE FTemp Double CE
x1)
irp (C.IUn IUn
p CE
e)        = IUn -> Exp -> Exp
IR.IU IUn
p (CE -> Exp
irE CE
e)
irp (C.BU BUn
op PE
e)        = BUn -> Exp -> Exp
IR.BU BUn
op (PE -> Exp
irp PE
e)
irp (C.Is BTemp
t)           = Temp -> Exp
IR.Is (BTemp -> Temp
cbtemp BTemp
t)
irp (C.PAt ArrAcc
a)          = AE -> Exp
IR.BAt (ArrAcc -> AE
irAt ArrAcc
a)
irp (C.BConst Bool
True)    = Int64 -> Exp
IR.ConstI Int64
1
irp (C.BConst Bool
False)   = Int64 -> Exp
IR.ConstI Int64
0
irp (C.Boo BBin
op PE
e0 PE
e1)   = IBin -> Exp -> Exp -> Exp
IB (BBin -> IBin
BI BBin
op) (PE -> Exp
irp PE
e0) (PE -> Exp
irp PE
e1)

irX :: F1E -> FExp
irX :: CFE FTemp Double CE -> FExp
irX (C.ConstF Double
x)    = Double -> FExp
IR.ConstF Double
x
irX (FTmp FTemp
t)        = FTemp -> FExp
FReg (FTemp -> FTemp
fx FTemp
t)
irX (C.FAt ArrAcc
a)       = AE -> FExp
IR.FAt (ArrAcc -> AE
irAt ArrAcc
a)
irX (FBin FBin
op CFE FTemp Double CE
x0 CFE FTemp Double CE
x1) = FBin -> FExp -> FExp -> FExp
FB FBin
op (CFE FTemp Double CE -> FExp
irX CFE FTemp Double CE
x0) (CFE FTemp Double CE -> FExp
irX CFE FTemp Double CE
x1)
irX (IE CE
e)          = Exp -> FExp
FConv (CE -> Exp
irE CE
e)
irX (FUn FUn
f CFE FTemp Double CE
e)       = FUn -> FExp -> FExp
FU FUn
f (CFE FTemp Double CE -> FExp
irX CFE FTemp Double CE
e)

foldMapM :: (t -> m b) -> t t -> m b
foldMapM t -> m b
f = (b -> t -> m b) -> b -> t t -> m b
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\b
x t
y -> (b
x b -> b -> b
forall a. Monoid a => a -> a -> a
`mappend`) (b -> b) -> m b -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> m b
f t
y) b
forall a. Monoid a => a
mempty