{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module CodeGen.RiscV.Lib.Monad where

import CodeGen.RiscV.Lib.Types (CodeLine)
import Control.Monad.Fix (MonadFix)
import Control.Monad.Identity (Identity (..))
import Control.Monad.State (MonadState (..), StateT (..), get, modify)
import Control.Monad.Trans (MonadTrans (..))
import Data.Int (Int64)

newtype AsmBuilderT m a = AsmBuilderT {forall (m :: * -> *) a. AsmBuilderT m a -> StateT BuilderState m a
unAsmBuilderT :: StateT BuilderState m a}
  deriving ((forall a b. (a -> b) -> AsmBuilderT m a -> AsmBuilderT m b)
-> (forall a b. a -> AsmBuilderT m b -> AsmBuilderT m a)
-> Functor (AsmBuilderT m)
forall a b. a -> AsmBuilderT m b -> AsmBuilderT m a
forall a b. (a -> b) -> AsmBuilderT m a -> AsmBuilderT m b
forall (m :: * -> *) a b.
Functor m =>
a -> AsmBuilderT m b -> AsmBuilderT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> AsmBuilderT m a -> AsmBuilderT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> AsmBuilderT m a -> AsmBuilderT m b
fmap :: forall a b. (a -> b) -> AsmBuilderT m a -> AsmBuilderT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> AsmBuilderT m b -> AsmBuilderT m a
<$ :: forall a b. a -> AsmBuilderT m b -> AsmBuilderT m a
Functor, Functor (AsmBuilderT m)
Functor (AsmBuilderT m)
-> (forall a. a -> AsmBuilderT m a)
-> (forall a b.
    AsmBuilderT m (a -> b) -> AsmBuilderT m a -> AsmBuilderT m b)
-> (forall a b c.
    (a -> b -> c)
    -> AsmBuilderT m a -> AsmBuilderT m b -> AsmBuilderT m c)
-> (forall a b.
    AsmBuilderT m a -> AsmBuilderT m b -> AsmBuilderT m b)
-> (forall a b.
    AsmBuilderT m a -> AsmBuilderT m b -> AsmBuilderT m a)
-> Applicative (AsmBuilderT m)
forall a. a -> AsmBuilderT m a
forall a b. AsmBuilderT m a -> AsmBuilderT m b -> AsmBuilderT m a
forall a b. AsmBuilderT m a -> AsmBuilderT m b -> AsmBuilderT m b
forall a b.
AsmBuilderT m (a -> b) -> AsmBuilderT m a -> AsmBuilderT m b
forall a b c.
(a -> b -> c)
-> AsmBuilderT m a -> AsmBuilderT m b -> AsmBuilderT m c
forall {m :: * -> *}. Monad m => Functor (AsmBuilderT m)
forall (m :: * -> *) a. Monad m => a -> AsmBuilderT m a
forall (m :: * -> *) a b.
Monad m =>
AsmBuilderT m a -> AsmBuilderT m b -> AsmBuilderT m a
forall (m :: * -> *) a b.
Monad m =>
AsmBuilderT m a -> AsmBuilderT m b -> AsmBuilderT m b
forall (m :: * -> *) a b.
Monad m =>
AsmBuilderT m (a -> b) -> AsmBuilderT m a -> AsmBuilderT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> AsmBuilderT m a -> AsmBuilderT m b -> AsmBuilderT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (m :: * -> *) a. Monad m => a -> AsmBuilderT m a
pure :: forall a. a -> AsmBuilderT m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
AsmBuilderT m (a -> b) -> AsmBuilderT m a -> AsmBuilderT m b
<*> :: forall a b.
AsmBuilderT m (a -> b) -> AsmBuilderT m a -> AsmBuilderT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> AsmBuilderT m a -> AsmBuilderT m b -> AsmBuilderT m c
liftA2 :: forall a b c.
(a -> b -> c)
-> AsmBuilderT m a -> AsmBuilderT m b -> AsmBuilderT m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
AsmBuilderT m a -> AsmBuilderT m b -> AsmBuilderT m b
*> :: forall a b. AsmBuilderT m a -> AsmBuilderT m b -> AsmBuilderT m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
AsmBuilderT m a -> AsmBuilderT m b -> AsmBuilderT m a
<* :: forall a b. AsmBuilderT m a -> AsmBuilderT m b -> AsmBuilderT m a
Applicative, Applicative (AsmBuilderT m)
Applicative (AsmBuilderT m)
-> (forall a b.
    AsmBuilderT m a -> (a -> AsmBuilderT m b) -> AsmBuilderT m b)
-> (forall a b.
    AsmBuilderT m a -> AsmBuilderT m b -> AsmBuilderT m b)
-> (forall a. a -> AsmBuilderT m a)
-> Monad (AsmBuilderT m)
forall a. a -> AsmBuilderT m a
forall a b. AsmBuilderT m a -> AsmBuilderT m b -> AsmBuilderT m b
forall a b.
AsmBuilderT m a -> (a -> AsmBuilderT m b) -> AsmBuilderT m b
forall (m :: * -> *). Monad m => Applicative (AsmBuilderT m)
forall (m :: * -> *) a. Monad m => a -> AsmBuilderT m a
forall (m :: * -> *) a b.
Monad m =>
AsmBuilderT m a -> AsmBuilderT m b -> AsmBuilderT m b
forall (m :: * -> *) a b.
Monad m =>
AsmBuilderT m a -> (a -> AsmBuilderT m b) -> AsmBuilderT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
AsmBuilderT m a -> (a -> AsmBuilderT m b) -> AsmBuilderT m b
>>= :: forall a b.
AsmBuilderT m a -> (a -> AsmBuilderT m b) -> AsmBuilderT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
AsmBuilderT m a -> AsmBuilderT m b -> AsmBuilderT m b
>> :: forall a b. AsmBuilderT m a -> AsmBuilderT m b -> AsmBuilderT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> AsmBuilderT m a
return :: forall a. a -> AsmBuilderT m a
Monad, Monad (AsmBuilderT m)
Monad (AsmBuilderT m)
-> (forall a. (a -> AsmBuilderT m a) -> AsmBuilderT m a)
-> MonadFix (AsmBuilderT m)
forall a. (a -> AsmBuilderT m a) -> AsmBuilderT m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
forall {m :: * -> *}. MonadFix m => Monad (AsmBuilderT m)
forall (m :: * -> *) a.
MonadFix m =>
(a -> AsmBuilderT m a) -> AsmBuilderT m a
$cmfix :: forall (m :: * -> *) a.
MonadFix m =>
(a -> AsmBuilderT m a) -> AsmBuilderT m a
mfix :: forall a. (a -> AsmBuilderT m a) -> AsmBuilderT m a
MonadFix) via StateT BuilderState m

data BuilderState = BS
  { BuilderState -> ProgramBuilderState
programBS :: ProgramBuilderState,
    BuilderState -> FunctionBuilderState
functionBS :: FunctionBuilderState,
    BuilderState -> Integer
idCnt :: Integer
  }

data ProgramBuilderState = PBS
  { ProgramBuilderState -> [[CodeLine]]
sectionText :: [[CodeLine]],
    ProgramBuilderState -> [CodeLine]
sectionData :: [CodeLine]
  }

data FunctionBuilderState = FBS
  { FunctionBuilderState -> [[CodeLine]]
functionCodeLines :: [[CodeLine]],
    FunctionBuilderState -> Int64
stackPointerOffset :: Int64 -- In double words
  }

emptyBS :: BuilderState
emptyBS :: BuilderState
emptyBS = ProgramBuilderState
-> FunctionBuilderState -> Integer -> BuilderState
BS ProgramBuilderState
emptyPBS FunctionBuilderState
emptyFBS Integer
0

emptyPBS :: ProgramBuilderState
emptyPBS :: ProgramBuilderState
emptyPBS = [[CodeLine]] -> [CodeLine] -> ProgramBuilderState
PBS [] []

emptyFBS :: FunctionBuilderState
emptyFBS :: FunctionBuilderState
emptyFBS = [[CodeLine]] -> Int64 -> FunctionBuilderState
FBS [] Int64
0

instance (MonadState s m) => MonadState s (AsmBuilderT m) where
  state :: forall a. (s -> (a, s)) -> AsmBuilderT m a
state = m a -> AsmBuilderT m a
forall (m :: * -> *) a. Monad m => m a -> AsmBuilderT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> AsmBuilderT m a)
-> ((s -> (a, s)) -> m a) -> (s -> (a, s)) -> AsmBuilderT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> (a, s)) -> m a
forall a. (s -> (a, s)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state

instance MonadTrans AsmBuilderT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> AsmBuilderT m a
lift = StateT BuilderState m a -> AsmBuilderT m a
forall (m :: * -> *) a. StateT BuilderState m a -> AsmBuilderT m a
AsmBuilderT (StateT BuilderState m a -> AsmBuilderT m a)
-> (m a -> StateT BuilderState m a) -> m a -> AsmBuilderT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> StateT BuilderState m a
forall (m :: * -> *) a. Monad m => m a -> StateT BuilderState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

type AsmBuilder = AsmBuilderT Identity

class (Monad m) => MonadAsmBuilder m where
  getAsmBuilderState :: m BuilderState

  modifyAsmBuilderState :: (BuilderState -> BuilderState) -> m ()

  default getAsmBuilderState ::
    (MonadTrans t, MonadAsmBuilder m1, m ~ t m1) =>
    m BuilderState
  getAsmBuilderState = m1 BuilderState -> t m1 BuilderState
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m1 BuilderState
forall (m :: * -> *). MonadAsmBuilder m => m BuilderState
getAsmBuilderState

  default modifyAsmBuilderState ::
    (MonadTrans t, MonadAsmBuilder m1, m ~ t m1) =>
    (BuilderState -> BuilderState) ->
    m ()
  modifyAsmBuilderState = m1 () -> m ()
m1 () -> t m1 ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m1 () -> m ())
-> ((BuilderState -> BuilderState) -> m1 ())
-> (BuilderState -> BuilderState)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BuilderState -> BuilderState) -> m1 ()
forall (m :: * -> *).
MonadAsmBuilder m =>
(BuilderState -> BuilderState) -> m ()
modifyAsmBuilderState

instance (Monad m) => MonadAsmBuilder (AsmBuilderT m) where
  getAsmBuilderState :: AsmBuilderT m BuilderState
getAsmBuilderState = StateT BuilderState m BuilderState -> AsmBuilderT m BuilderState
forall (m :: * -> *) a. StateT BuilderState m a -> AsmBuilderT m a
AsmBuilderT StateT BuilderState m BuilderState
forall s (m :: * -> *). MonadState s m => m s
get

  modifyAsmBuilderState :: (BuilderState -> BuilderState) -> AsmBuilderT m ()
modifyAsmBuilderState = StateT BuilderState m () -> AsmBuilderT m ()
forall (m :: * -> *) a. StateT BuilderState m a -> AsmBuilderT m a
AsmBuilderT (StateT BuilderState m () -> AsmBuilderT m ())
-> ((BuilderState -> BuilderState) -> StateT BuilderState m ())
-> (BuilderState -> BuilderState)
-> AsmBuilderT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BuilderState -> BuilderState) -> StateT BuilderState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify

instance (MonadAsmBuilder m) => MonadAsmBuilder (StateT s m)