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
    {
        Context start a -> EnumMap start StateNum
ctxInitials     :: EnumMap.EnumMap start SRB.StateNum,
        Context start a -> StateNum
ctxNextStateNum :: SRB.StateNum,
        Context start a -> T StateNum MState
ctxStates       :: AlignableMap.T SRB.StateNum SRB.MState
    }
    deriving (Context start a -> Context start a -> Bool
(Context start a -> Context start a -> Bool)
-> (Context start a -> Context start a -> Bool)
-> Eq (Context start a)
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
[Context start a] -> ShowS
Context start a -> String
(Int -> Context start a -> ShowS)
-> (Context start a -> String)
-> ([Context start a] -> ShowS)
-> Show (Context start a)
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 :: 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 <- BuilderT start a m () -> Context start a -> m (Context start a)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT BuilderT start a m ()
builder Context start a
forall k start (a :: k). Context start a
initialCtx
    T start varDoc altDoc a -> m (T start varDoc altDoc a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure do
        SRB :: forall start varDoc altDoc a.
EnumMap start StateNum
-> T StateNum MState
-> T AltNum (Alt altDoc a)
-> T VarNum (Var varDoc)
-> SRB start varDoc altDoc a
SRB.SRB
            { $sel:initials:SRB :: EnumMap start StateNum
initials = Context start a -> EnumMap start StateNum
forall start k (a :: k). Context start a -> EnumMap start StateNum
ctxInitials Context start a
finalCtx
            , $sel:states:SRB :: T StateNum MState
states = StateNum -> T StateNum MState -> T StateNum MState
forall n a. T n => n -> T n a -> Array n a
AlignableArray.fromTotalMap
                do Context start a -> StateNum
forall start k (a :: k). Context start a -> StateNum
ctxNextStateNum Context start a
finalCtx
                do Context start a -> T StateNum MState
forall start k (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 :: forall k start (a :: k).
EnumMap start StateNum
-> StateNum -> T StateNum MState -> Context start a
Context
            {
                $sel:ctxInitials:Context :: EnumMap start StateNum
ctxInitials = EnumMap start StateNum
forall k a. EnumMap k a
EnumMap.empty,
                $sel:ctxNextStateNum:Context :: StateNum
ctxNextStateNum = StateNum
forall i. Alignable i => i
Alignable.initialAlign,
                $sel:ctxStates:Context :: T StateNum MState
ctxStates = T StateNum MState
forall k (n :: k) a. Map n a
AlignableMap.empty
            }

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

registerInitial :: Monad m => Enum start
    => start -> SRB.StateNum -> BuilderT start a m ()
registerInitial :: start -> StateNum -> BuilderT start a m ()
registerInitial start
i StateNum
v = (Context start a -> Context start a) -> BuilderT start a m ()
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 = start
-> StateNum -> EnumMap start StateNum -> EnumMap start StateNum
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EnumMap.insert start
i StateNum
v do Context start a -> EnumMap start StateNum
forall start k (a :: k). Context start a -> EnumMap start StateNum
ctxInitials Context start a
ctx
    }

addState :: Monad m => SRB.MState -> BuilderT s a m ()
addState :: MState -> BuilderT s a m ()
addState MState
s = (Context s a -> Context s a) -> BuilderT s a m ()
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 = StateNum -> MState -> T StateNum MState -> T StateNum MState
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 Context s a -> T StateNum MState
forall start k (a :: k). Context start a -> T StateNum MState
ctxStates Context s a
ctx
    }