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.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.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