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 }