module Kempe.Pipeline ( irGen
                      , x86Parsed
                      , x86Alloc
                      , armParsed
                      , armAlloc
                      ) where

import           Control.Composition       ((.*))
import           Control.Exception         (throw)
import           Data.Bifunctor            (first)
import           Data.Typeable             (Typeable)
import           Kempe.AST
import           Kempe.AST.Size
import qualified Kempe.Asm.Arm.ControlFlow as Arm
import qualified Kempe.Asm.Arm.Linear      as Arm
import           Kempe.Asm.Arm.Opt
import           Kempe.Asm.Arm.Trans
import qualified Kempe.Asm.Arm.Type        as Arm
import           Kempe.Asm.Liveness
import qualified Kempe.Asm.X86.ControlFlow as X86
import qualified Kempe.Asm.X86.Linear      as X86
import           Kempe.Asm.X86.Trans
import qualified Kempe.Asm.X86.Type        as X86
import           Kempe.Check.Restrict
import           Kempe.IR
import           Kempe.IR.Opt
import           Kempe.IR.Type
import           Kempe.Shuttle

irGen :: Typeable a
      => Int -- ^ Thread uniques through
      -> Declarations a c b -> ([Stmt], WriteSt, SizeEnv)
irGen :: Int -> Declarations a c b -> ([Stmt], WriteSt, SizeEnv)
irGen Int
i Declarations a c b
m = ([Stmt], WriteSt) -> ([Stmt], WriteSt, SizeEnv)
forall a b. (a, b) -> (a, b, SizeEnv)
adjEnv (([Stmt], WriteSt) -> ([Stmt], WriteSt, SizeEnv))
-> ([Stmt], WriteSt) -> ([Stmt], WriteSt, SizeEnv)
forall a b. (a -> b) -> a -> b
$ ([Stmt] -> [Stmt]) -> ([Stmt], WriteSt) -> ([Stmt], WriteSt)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [Stmt] -> [Stmt]
optimize (([Stmt], WriteSt) -> ([Stmt], WriteSt))
-> ([Stmt], WriteSt) -> ([Stmt], WriteSt)
forall a b. (a -> b) -> a -> b
$ TempM [Stmt] -> ([Stmt], WriteSt)
forall a. TempM a -> (a, WriteSt)
runTempM (SizeEnv
-> Declarations () (ConsAnn MonoStackType) MonoStackType
-> TempM [Stmt]
writeModule SizeEnv
env Declarations () (ConsAnn MonoStackType) MonoStackType
tAnnMod)
    where (Declarations () (ConsAnn MonoStackType) MonoStackType
tAnnMod, SizeEnv
env) = (Error ()
 -> (Declarations () (ConsAnn MonoStackType) MonoStackType,
     SizeEnv))
-> ((Declarations () (ConsAnn MonoStackType) MonoStackType,
     SizeEnv)
    -> (Declarations () (ConsAnn MonoStackType) MonoStackType,
        SizeEnv))
-> Either
     (Error ())
     (Declarations () (ConsAnn MonoStackType) MonoStackType, SizeEnv)
-> (Declarations () (ConsAnn MonoStackType) MonoStackType, SizeEnv)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Error ()
-> (Declarations () (ConsAnn MonoStackType) MonoStackType, SizeEnv)
forall a e. Exception e => e -> a
throw (Declarations () (ConsAnn MonoStackType) MonoStackType, SizeEnv)
-> (Declarations () (ConsAnn MonoStackType) MonoStackType, SizeEnv)
forall a. a -> a
id (Either
   (Error ())
   (Declarations () (ConsAnn MonoStackType) MonoStackType, SizeEnv)
 -> (Declarations () (ConsAnn MonoStackType) MonoStackType,
     SizeEnv))
-> Either
     (Error ())
     (Declarations () (ConsAnn MonoStackType) MonoStackType, SizeEnv)
-> (Declarations () (ConsAnn MonoStackType) MonoStackType, SizeEnv)
forall a b. (a -> b) -> a -> b
$ Int
-> Declarations a c b
-> Either
     (Error ())
     (Declarations () (ConsAnn MonoStackType) MonoStackType, SizeEnv)
forall a c b.
Int
-> Declarations a c b
-> Either
     (Error ())
     (Declarations () (ConsAnn MonoStackType) MonoStackType, SizeEnv)
monomorphize Int
i Declarations a c b
mOk
          mOk :: Declarations a c b
mOk = Declarations a c b
-> (Error a -> Declarations a c b)
-> Maybe (Error a)
-> Declarations a c b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Declarations a c b
m Error a -> Declarations a c b
forall a e. Exception e => e -> a
throw (Declarations a c b -> Maybe (Error a)
forall a c b. Declarations a c b -> Maybe (Error a)
restrictConstructors Declarations a c b
m)
          adjEnv :: (a, b) -> (a, b, SizeEnv)
adjEnv (a
x, b
y) = (a
x, b
y, SizeEnv
env)

armParsed :: Typeable a => Int -> Declarations a c b -> [Arm.Arm Arm.AbsReg ()]
armParsed :: Int -> Declarations a c b -> [Arm AbsReg ()]
armParsed Int
i Declarations a c b
m = let ([Stmt]
ir, WriteSt
u, SizeEnv
env) = Int -> Declarations a c b -> ([Stmt], WriteSt, SizeEnv)
forall a c b.
Typeable a =>
Int -> Declarations a c b -> ([Stmt], WriteSt, SizeEnv)
irGen Int
i Declarations a c b
m in SizeEnv -> WriteSt -> [Stmt] -> [Arm AbsReg ()]
irToAarch64 SizeEnv
env WriteSt
u [Stmt]
ir

armAlloc :: Typeable a => Int -> Declarations a c b -> [Arm.Arm Arm.ArmReg ()]
armAlloc :: Int -> Declarations a c b -> [Arm ArmReg ()]
armAlloc = [Arm ArmReg ()] -> [Arm ArmReg ()]
forall reg a. Eq reg => [Arm reg a] -> [Arm reg a]
optimizeArm ([Arm ArmReg ()] -> [Arm ArmReg ()])
-> ([Arm AbsReg ()] -> [Arm ArmReg ()])
-> [Arm AbsReg ()]
-> [Arm ArmReg ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Arm AbsReg Liveness] -> [Arm ArmReg ()]
Arm.allocRegs ([Arm AbsReg Liveness] -> [Arm ArmReg ()])
-> ([Arm AbsReg ()] -> [Arm AbsReg Liveness])
-> [Arm AbsReg ()]
-> [Arm ArmReg ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Arm AbsReg ControlAnn] -> [Arm AbsReg Liveness]
forall (p :: * -> *).
(Copointed p, Functor p) =>
[p ControlAnn] -> [p Liveness]
reconstruct ([Arm AbsReg ControlAnn] -> [Arm AbsReg Liveness])
-> ([Arm AbsReg ()] -> [Arm AbsReg ControlAnn])
-> [Arm AbsReg ()]
-> [Arm AbsReg Liveness]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Arm AbsReg ()] -> [Arm AbsReg ControlAnn]
Arm.mkControlFlow ([Arm AbsReg ()] -> [Arm ArmReg ()])
-> (Int -> Declarations a c b -> [Arm AbsReg ()])
-> Int
-> Declarations a c b
-> [Arm ArmReg ()]
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* Int -> Declarations a c b -> [Arm AbsReg ()]
forall a c b.
Typeable a =>
Int -> Declarations a c b -> [Arm AbsReg ()]
armParsed

x86Parsed :: Typeable a => Int -> Declarations a c b -> [X86.X86 X86.AbsReg ()]
x86Parsed :: Int -> Declarations a c b -> [X86 AbsReg ()]
x86Parsed Int
i Declarations a c b
m = let ([Stmt]
ir, WriteSt
u, SizeEnv
env) = Int -> Declarations a c b -> ([Stmt], WriteSt, SizeEnv)
forall a c b.
Typeable a =>
Int -> Declarations a c b -> ([Stmt], WriteSt, SizeEnv)
irGen Int
i Declarations a c b
m in SizeEnv -> WriteSt -> [Stmt] -> [X86 AbsReg ()]
irToX86 SizeEnv
env WriteSt
u [Stmt]
ir

x86Alloc :: Typeable a => Int -> Declarations a c b -> [X86.X86 X86.X86Reg ()]
x86Alloc :: Int -> Declarations a c b -> [X86 X86Reg ()]
x86Alloc = [X86 AbsReg Liveness] -> [X86 X86Reg ()]
X86.allocRegs ([X86 AbsReg Liveness] -> [X86 X86Reg ()])
-> ([X86 AbsReg ()] -> [X86 AbsReg Liveness])
-> [X86 AbsReg ()]
-> [X86 X86Reg ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [X86 AbsReg ControlAnn] -> [X86 AbsReg Liveness]
forall (p :: * -> *).
(Copointed p, Functor p) =>
[p ControlAnn] -> [p Liveness]
reconstruct ([X86 AbsReg ControlAnn] -> [X86 AbsReg Liveness])
-> ([X86 AbsReg ()] -> [X86 AbsReg ControlAnn])
-> [X86 AbsReg ()]
-> [X86 AbsReg Liveness]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [X86 AbsReg ()] -> [X86 AbsReg ControlAnn]
X86.mkControlFlow ([X86 AbsReg ()] -> [X86 X86Reg ()])
-> (Int -> Declarations a c b -> [X86 AbsReg ()])
-> Int
-> Declarations a c b
-> [X86 X86Reg ()]
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* Int -> Declarations a c b -> [X86 AbsReg ()]
forall a c b.
Typeable a =>
Int -> Declarations a c b -> [X86 AbsReg ()]
x86Parsed