module Language.Parser.Ptera.Machine.SRB.Builder where

import           Language.Parser.Ptera.Prelude

import qualified Data.EnumMap.Strict                        as EnumMap
import qualified Language.Parser.Ptera.Data.Alignable       as Alignable
import qualified Language.Parser.Ptera.Data.Alignable.Array as AlignableArray
import qualified Language.Parser.Ptera.Data.Alignable.Map   as AlignableMap
import qualified Language.Parser.Ptera.Machine.LAPEG        as LAPEG
import qualified Language.Parser.Ptera.Machine.PEG          as PEG
import qualified Language.Parser.Ptera.Machine.SRB          as SRB


type T start a = BuilderT start a

type BuilderT start a = StateT (Context start a)

data Context start a = Context
    {
        forall {k} start (a :: k).
Context start a -> EnumMap start StateNum
ctxInitials     :: EnumMap.EnumMap start SRB.StateNum,
        forall {k} start (a :: k). Context start a -> StateNum
ctxNextStateNum :: SRB.StateNum,
        forall {k} start (a :: k). Context start a -> T StateNum MState
ctxStates       :: AlignableMap.T SRB.StateNum SRB.MState
    }
    deriving (Context start a -> Context start a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall start k (a :: k). Context start a -> Context start a -> Bool
/= :: Context start a -> Context start a -> Bool
$c/= :: forall start k (a :: k). Context start a -> Context start a -> Bool
== :: Context start a -> Context start a -> Bool
$c== :: forall start k (a :: k). Context start a -> Context start a -> Bool
Eq, Int -> Context start a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall start k (a :: k).
(Enum start, Show start) =>
Int -> Context start a -> ShowS
forall start k (a :: k).
(Enum start, Show start) =>
[Context start a] -> ShowS
forall start k (a :: k).
(Enum start, Show start) =>
Context start a -> String
showList :: [Context start a] -> ShowS
$cshowList :: forall start k (a :: k).
(Enum start, Show start) =>
[Context start a] -> ShowS
show :: Context start a -> String
$cshow :: forall start k (a :: k).
(Enum start, Show start) =>
Context start a -> String
showsPrec :: Int -> Context start a -> ShowS
$cshowsPrec :: forall start k (a :: k).
(Enum start, Show start) =>
Int -> Context start a -> ShowS
Show)

type Vars varDoc = AlignableArray.T LAPEG.VarNum (PEG.Var varDoc)
type Alts altDoc a = AlignableArray.T LAPEG.AltNum (LAPEG.Alt altDoc a)

build :: Monad m
    => Vars varDoc -> Alts altDoc a -> BuilderT start a m ()
    -> m (SRB.T start varDoc altDoc a)
build :: forall (m :: * -> *) varDoc altDoc a start.
Monad m =>
Vars varDoc
-> Alts altDoc a
-> BuilderT start a m ()
-> m (T start varDoc altDoc a)
build Vars varDoc
vars Alts altDoc a
alts BuilderT start a m ()
builder = do
    Context start a
finalCtx <- forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT BuilderT start a m ()
builder forall {k} {start} {a :: k}. Context start a
initialCtx
    forall (f :: * -> *) a. Applicative f => a -> f a
pure do
        SRB.SRB
            { $sel:initials:SRB :: EnumMap start StateNum
initials = forall {k} start (a :: k).
Context start a -> EnumMap start StateNum
ctxInitials Context start a
finalCtx
            , $sel:states:SRB :: T StateNum MState
states = forall n a. T n => n -> T n a -> Array n a
AlignableArray.fromTotalMap
                do forall {k} start (a :: k). Context start a -> StateNum
ctxNextStateNum Context start a
finalCtx
                do forall {k} start (a :: k). Context start a -> T StateNum MState
ctxStates Context start a
finalCtx
            , $sel:alts:SRB :: Alts altDoc a
alts = Alts altDoc a
alts
            , $sel:vars:SRB :: Vars varDoc
vars = Vars varDoc
vars
            }
    where
        initialCtx :: Context start a
initialCtx = Context
            {
                $sel:ctxInitials:Context :: EnumMap start StateNum
ctxInitials = forall k a. EnumMap k a
EnumMap.empty,
                $sel:ctxNextStateNum:Context :: StateNum
ctxNextStateNum = forall i. Alignable i => i
Alignable.initialAlign,
                $sel:ctxStates:Context :: T StateNum MState
ctxStates = forall {k} (n :: k) a. Map n a
AlignableMap.empty
            }

genNewStateNum :: Monad m => BuilderT start a m SRB.StateNum
genNewStateNum :: forall {k} (m :: * -> *) start (a :: k).
Monad m =>
BuilderT start a m StateNum
genNewStateNum = do
    Context start a
ctx <- forall (m :: * -> *) s. Monad m => StateT s m s
get
    let sn :: StateNum
sn = forall {k} start (a :: k). Context start a -> StateNum
ctxNextStateNum Context start a
ctx
    forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put do Context start a
ctx { $sel:ctxNextStateNum:Context :: StateNum
ctxNextStateNum = forall i. Alignable i => i -> i
Alignable.nextAlign StateNum
sn }
    forall (f :: * -> *) a. Applicative f => a -> f a
pure StateNum
sn

registerInitial :: Monad m => Enum start
    => start -> SRB.StateNum -> BuilderT start a m ()
registerInitial :: forall {k} (m :: * -> *) start (a :: k).
(Monad m, Enum start) =>
start -> StateNum -> BuilderT start a m ()
registerInitial start
i StateNum
v = forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \Context start a
ctx -> Context start a
ctx
    {
        $sel:ctxInitials:Context :: EnumMap start StateNum
ctxInitials = forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EnumMap.insert start
i StateNum
v do forall {k} start (a :: k).
Context start a -> EnumMap start StateNum
ctxInitials Context start a
ctx
    }

addState :: Monad m => SRB.MState -> BuilderT s a m ()
addState :: forall {k} (m :: * -> *) s (a :: k).
Monad m =>
MState -> BuilderT s a m ()
addState MState
s = forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \Context s a
ctx -> Context s a
ctx
    {
        $sel:ctxStates:Context :: T StateNum MState
ctxStates = forall n a. T n => n -> a -> Map n a -> Map n a
AlignableMap.insert
            do MState -> StateNum
SRB.stateNum MState
s
            do MState
s
            do forall {k} start (a :: k). Context start a -> T StateNum MState
ctxStates Context s a
ctx
    }