-- | Put this in its own module to
module Kempe.IR.Monad ( WriteM
                      , nextLabels
                      , nextInt
                      , getInt
                      , getLabel
                      , runWriteM
                      , allocTemp8
                      , allocTemp64
                      ) where

import           Control.Monad.State.Strict (State, evalState, gets, modify)
import           Kempe.IR.Type

type WriteM = State WriteSt

nextLabels :: WriteSt -> WriteSt
nextLabels :: WriteSt -> WriteSt
nextLabels (WriteSt [Label]
ls [Int]
ts) = [Label] -> [Int] -> WriteSt
WriteSt ([Label] -> [Label]
forall a. [a] -> [a]
tail [Label]
ls) [Int]
ts

nextInt :: WriteSt -> WriteSt
nextInt :: WriteSt -> WriteSt
nextInt (WriteSt [Label]
ls [Int]
ts) = [Label] -> [Int] -> WriteSt
WriteSt [Label]
ls ([Int] -> [Int]
forall a. [a] -> [a]
tail [Int]
ts)

getInt :: WriteM Int
getInt :: WriteM Int
getInt = (WriteSt -> Int) -> WriteM Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ([Int] -> Int
forall a. [a] -> a
head ([Int] -> Int) -> (WriteSt -> [Int]) -> WriteSt -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriteSt -> [Int]
temps) WriteM Int -> StateT WriteSt Identity () -> WriteM Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (WriteSt -> WriteSt) -> StateT WriteSt Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify WriteSt -> WriteSt
nextInt

getLabel :: WriteM Label
getLabel :: WriteM Label
getLabel = (WriteSt -> Label) -> WriteM Label
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ([Label] -> Label
forall a. [a] -> a
head ([Label] -> Label) -> (WriteSt -> [Label]) -> WriteSt -> Label
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriteSt -> [Label]
wlabels) WriteM Label -> StateT WriteSt Identity () -> WriteM Label
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (WriteSt -> WriteSt) -> StateT WriteSt Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify WriteSt -> WriteSt
nextLabels

allocTemp64 :: WriteM Temp
allocTemp64 :: WriteM Temp
allocTemp64 = Int -> Temp
Temp64 (Int -> Temp) -> WriteM Int -> WriteM Temp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriteM Int
getInt

allocTemp8 :: WriteM Temp
allocTemp8 :: WriteM Temp
allocTemp8 = Int -> Temp
Temp8 (Int -> Temp) -> WriteM Int -> WriteM Temp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriteM Int
getInt

runWriteM :: WriteSt -> WriteM a -> a
runWriteM :: WriteSt -> WriteM a -> a
runWriteM = (WriteM a -> WriteSt -> a) -> WriteSt -> WriteM a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip WriteM a -> WriteSt -> a
forall s a. State s a -> s -> a
evalState