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

import           Control.Composition       ((.*))
import           Control.Exception         (throw)
import           Data.Bifunctor            (first)
import           Kempe.AST
import           Kempe.Asm.X86
import           Kempe.Asm.X86.ControlFlow
import           Kempe.Asm.X86.Linear
import           Kempe.Asm.X86.Liveness
import           Kempe.Asm.X86.Type
import           Kempe.IR
import           Kempe.IR.Opt
import           Kempe.Shuttle

irGen :: Int -- ^ Thread uniques through
      -> Module a c b -> ([Stmt], WriteSt)
irGen :: Int -> Module a c b -> ([Stmt], WriteSt)
irGen Int
i Module a c b
m = ([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 (Module () (ConsAnn MonoStackType) MonoStackType -> TempM [Stmt]
writeModule Module () (ConsAnn MonoStackType) MonoStackType
tAnnMod)
    where tAnnMod :: Module () (ConsAnn MonoStackType) MonoStackType
tAnnMod = (Error () -> Module () (ConsAnn MonoStackType) MonoStackType)
-> (Module () (ConsAnn MonoStackType) MonoStackType
    -> Module () (ConsAnn MonoStackType) MonoStackType)
-> Either
     (Error ()) (Module () (ConsAnn MonoStackType) MonoStackType)
-> Module () (ConsAnn MonoStackType) MonoStackType
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Error () -> Module () (ConsAnn MonoStackType) MonoStackType
forall a e. Exception e => e -> a
throw Module () (ConsAnn MonoStackType) MonoStackType
-> Module () (ConsAnn MonoStackType) MonoStackType
forall a. a -> a
id (Either
   (Error ()) (Module () (ConsAnn MonoStackType) MonoStackType)
 -> Module () (ConsAnn MonoStackType) MonoStackType)
-> Either
     (Error ()) (Module () (ConsAnn MonoStackType) MonoStackType)
-> Module () (ConsAnn MonoStackType) MonoStackType
forall a b. (a -> b) -> a -> b
$ Int
-> Module a c b
-> Either
     (Error ()) (Module () (ConsAnn MonoStackType) MonoStackType)
forall a c b.
Int
-> Module a c b
-> Either
     (Error ()) (Module () (ConsAnn MonoStackType) MonoStackType)
monomorphize Int
i Module a c b
m

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

x86Alloc :: Int -> Module a c b -> [X86 X86Reg ()]
x86Alloc :: Int -> Module a c b -> [X86 X86Reg ()]
x86Alloc = [X86 AbsReg Liveness] -> [X86 X86Reg ()]
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 reg. [X86 reg ControlAnn] -> [X86 reg 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]
mkControlFlow ([X86 AbsReg ()] -> [X86 X86Reg ()])
-> (Int -> Module a c b -> [X86 AbsReg ()])
-> Int
-> Module a c b
-> [X86 X86Reg ()]
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* Int -> Module a c b -> [X86 AbsReg ()]
forall a c b. Int -> Module a c b -> [X86 AbsReg ()]
x86Parsed