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

import           Control.Composition       ((.*))
import           Control.Exception         (throw)
import           Data.Bifunctor            (first)
import           Data.Typeable             (Typeable)
import           Kempe.AST
import           Kempe.AST.Size
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.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)

x86Parsed :: Typeable a => Int -> Declarations a c b -> [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 X86Reg ()]
x86Alloc :: Int -> Declarations 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 -> 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