module Language.Parser.Ptera.Machine.LAPEG.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 type T start varDoc altDoc a = BuilderT start varDoc altDoc a type BuilderT start varDoc altDoc a = StateT (Context start varDoc altDoc a) data Context start varDoc altDoc a = Context { forall start varDoc altDoc a. Context start varDoc altDoc a -> EnumMap start VarNum ctxInitials :: EnumMap.EnumMap start LAPEG.VarNum , forall start varDoc altDoc a. Context start varDoc altDoc a -> VarNum ctxNextVarNum :: LAPEG.VarNum , forall start varDoc altDoc a. Context start varDoc altDoc a -> AltNum ctxNextAltNum :: LAPEG.AltNum , forall start varDoc altDoc a. Context start varDoc altDoc a -> T VarNum (Var varDoc) ctxVars :: AlignableMap.T LAPEG.VarNum (PEG.Var varDoc) , forall start varDoc altDoc a. Context start varDoc altDoc a -> T VarNum Rule ctxRules :: AlignableMap.T LAPEG.VarNum LAPEG.Rule , forall start varDoc altDoc a. Context start varDoc altDoc a -> T AltNum (Alt altDoc a) ctxAlts :: AlignableMap.T LAPEG.AltNum (LAPEG.Alt altDoc a) } deriving (Context start varDoc altDoc a -> Context start varDoc altDoc a -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a forall start varDoc altDoc a. (Eq varDoc, Eq a, Eq altDoc) => Context start varDoc altDoc a -> Context start varDoc altDoc a -> Bool /= :: Context start varDoc altDoc a -> Context start varDoc altDoc a -> Bool $c/= :: forall start varDoc altDoc a. (Eq varDoc, Eq a, Eq altDoc) => Context start varDoc altDoc a -> Context start varDoc altDoc a -> Bool == :: Context start varDoc altDoc a -> Context start varDoc altDoc a -> Bool $c== :: forall start varDoc altDoc a. (Eq varDoc, Eq a, Eq altDoc) => Context start varDoc altDoc a -> Context start varDoc altDoc a -> Bool Eq, Int -> Context start varDoc altDoc a -> ShowS forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a forall start varDoc altDoc a. (Enum start, Show start, Show varDoc, Show a, Show altDoc) => Int -> Context start varDoc altDoc a -> ShowS forall start varDoc altDoc a. (Enum start, Show start, Show varDoc, Show a, Show altDoc) => [Context start varDoc altDoc a] -> ShowS forall start varDoc altDoc a. (Enum start, Show start, Show varDoc, Show a, Show altDoc) => Context start varDoc altDoc a -> String showList :: [Context start varDoc altDoc a] -> ShowS $cshowList :: forall start varDoc altDoc a. (Enum start, Show start, Show varDoc, Show a, Show altDoc) => [Context start varDoc altDoc a] -> ShowS show :: Context start varDoc altDoc a -> String $cshow :: forall start varDoc altDoc a. (Enum start, Show start, Show varDoc, Show a, Show altDoc) => Context start varDoc altDoc a -> String showsPrec :: Int -> Context start varDoc altDoc a -> ShowS $cshowsPrec :: forall start varDoc altDoc a. (Enum start, Show start, Show varDoc, Show a, Show altDoc) => Int -> Context start varDoc altDoc a -> ShowS Show, forall a b. a -> Context start varDoc altDoc b -> Context start varDoc altDoc a forall a b. (a -> b) -> Context start varDoc altDoc a -> Context start varDoc altDoc b forall start varDoc altDoc a b. a -> Context start varDoc altDoc b -> Context start varDoc altDoc a forall start varDoc altDoc a b. (a -> b) -> Context start varDoc altDoc a -> Context start varDoc altDoc b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f <$ :: forall a b. a -> Context start varDoc altDoc b -> Context start varDoc altDoc a $c<$ :: forall start varDoc altDoc a b. a -> Context start varDoc altDoc b -> Context start varDoc altDoc a fmap :: forall a b. (a -> b) -> Context start varDoc altDoc a -> Context start varDoc altDoc b $cfmap :: forall start varDoc altDoc a b. (a -> b) -> Context start varDoc altDoc a -> Context start varDoc altDoc b Functor) build :: Monad m => BuilderT start varDoc altDoc a m () -> m (LAPEG.T start varDoc altDoc a) build :: forall (m :: * -> *) start varDoc altDoc a. Monad m => BuilderT start varDoc altDoc a m () -> m (T start varDoc altDoc a) build BuilderT start varDoc altDoc a m () builder = do Context start varDoc altDoc a finalCtx <- forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s execStateT BuilderT start varDoc altDoc a m () builder forall {start} {varDoc} {altDoc} {a}. Context start varDoc altDoc a initialCtx forall (f :: * -> *) a. Applicative f => a -> f a pure do LAPEG.LAPEG { $sel:initials:LAPEG :: EnumMap start VarNum initials = forall start varDoc altDoc a. Context start varDoc altDoc a -> EnumMap start VarNum ctxInitials Context start varDoc altDoc a finalCtx , $sel:rules:LAPEG :: T VarNum Rule rules = forall n a. T n => n -> T n a -> Array n a AlignableArray.fromTotalMap do forall start varDoc altDoc a. Context start varDoc altDoc a -> VarNum ctxNextVarNum Context start varDoc altDoc a finalCtx do forall start varDoc altDoc a. Context start varDoc altDoc a -> T VarNum Rule ctxRules Context start varDoc altDoc a finalCtx , $sel:vars:LAPEG :: T VarNum (Var varDoc) vars = forall n a. T n => n -> T n a -> Array n a AlignableArray.fromTotalMap do forall start varDoc altDoc a. Context start varDoc altDoc a -> VarNum ctxNextVarNum Context start varDoc altDoc a finalCtx do forall start varDoc altDoc a. Context start varDoc altDoc a -> T VarNum (Var varDoc) ctxVars Context start varDoc altDoc a finalCtx , $sel:alts:LAPEG :: T AltNum (Alt altDoc a) alts = forall n a. T n => n -> T n a -> Array n a AlignableArray.fromTotalMap do forall start varDoc altDoc a. Context start varDoc altDoc a -> AltNum ctxNextAltNum Context start varDoc altDoc a finalCtx do forall start varDoc altDoc a. Context start varDoc altDoc a -> T AltNum (Alt altDoc a) ctxAlts Context start varDoc altDoc a finalCtx } where initialCtx :: Context start varDoc altDoc a initialCtx = Context { $sel:ctxInitials:Context :: EnumMap start VarNum ctxInitials = forall k a. EnumMap k a EnumMap.empty , $sel:ctxNextVarNum:Context :: VarNum ctxNextVarNum = forall i. Alignable i => i Alignable.initialAlign , $sel:ctxNextAltNum:Context :: AltNum ctxNextAltNum = forall i. Alignable i => i Alignable.initialAlign , $sel:ctxRules:Context :: T VarNum Rule ctxRules = forall {k} (n :: k) a. Map n a AlignableMap.empty , $sel:ctxVars:Context :: T VarNum (Var varDoc) ctxVars = forall {k} (n :: k) a. Map n a AlignableMap.empty , $sel:ctxAlts:Context :: T AltNum (Alt altDoc a) ctxAlts = forall {k} (n :: k) a. Map n a AlignableMap.empty } genNewVar :: Monad m => PEG.Var varDoc -> BuilderT start varDoc altDoc a m LAPEG.VarNum genNewVar :: forall (m :: * -> *) varDoc start altDoc a. Monad m => Var varDoc -> BuilderT start varDoc altDoc a m VarNum genNewVar Var varDoc v = do VarNum vn <- forall start varDoc altDoc a. Context start varDoc altDoc a -> VarNum ctxNextVarNum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *) s. Monad m => StateT s m s get forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m () modify' \Context start varDoc altDoc a ctx -> Context start varDoc altDoc a ctx { $sel:ctxNextVarNum:Context :: VarNum ctxNextVarNum = forall i. Alignable i => i -> i Alignable.nextAlign VarNum vn , $sel:ctxVars:Context :: T VarNum (Var varDoc) ctxVars = forall n a. T n => n -> a -> Map n a -> Map n a AlignableMap.insert VarNum vn Var varDoc v do forall start varDoc altDoc a. Context start varDoc altDoc a -> T VarNum (Var varDoc) ctxVars Context start varDoc altDoc a ctx } forall (f :: * -> *) a. Applicative f => a -> f a pure VarNum vn genNewAlt :: Monad m => LAPEG.Alt altDoc a -> BuilderT start varDoc altDoc a m LAPEG.AltNum genNewAlt :: forall (m :: * -> *) altDoc a start varDoc. Monad m => Alt altDoc a -> BuilderT start varDoc altDoc a m AltNum genNewAlt Alt altDoc a alt = do AltNum altn <- forall start varDoc altDoc a. Context start varDoc altDoc a -> AltNum ctxNextAltNum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *) s. Monad m => StateT s m s get forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m () modify' \Context start varDoc altDoc a ctx -> Context start varDoc altDoc a ctx { $sel:ctxNextAltNum:Context :: AltNum ctxNextAltNum = forall i. Alignable i => i -> i Alignable.nextAlign AltNum altn , $sel:ctxAlts:Context :: T AltNum (Alt altDoc a) ctxAlts = forall n a. T n => n -> a -> Map n a -> Map n a AlignableMap.insert AltNum altn Alt altDoc a alt do forall start varDoc altDoc a. Context start varDoc altDoc a -> T AltNum (Alt altDoc a) ctxAlts Context start varDoc altDoc a ctx } forall (f :: * -> *) a. Applicative f => a -> f a pure AltNum altn addInitial :: Monad m => Enum start => start -> LAPEG.VarNum -> BuilderT start varDoc altDoc a m () addInitial :: forall (m :: * -> *) start varDoc altDoc a. (Monad m, Enum start) => start -> VarNum -> BuilderT start varDoc altDoc a m () addInitial start i VarNum v = forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m () modify' \Context start varDoc altDoc a ctx -> Context start varDoc altDoc a ctx { $sel:ctxInitials:Context :: EnumMap start VarNum ctxInitials = forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a EnumMap.insert start i VarNum v do forall start varDoc altDoc a. Context start varDoc altDoc a -> EnumMap start VarNum ctxInitials Context start varDoc altDoc a ctx } addRule :: Monad m => LAPEG.VarNum -> LAPEG.Rule -> BuilderT start varDoc altDoc a m () addRule :: forall (m :: * -> *) start varDoc altDoc a. Monad m => VarNum -> Rule -> BuilderT start varDoc altDoc a m () addRule VarNum v Rule e = forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m () modify' \Context start varDoc altDoc a ctx -> Context start varDoc altDoc a ctx { $sel:ctxRules:Context :: T VarNum Rule ctxRules = forall n a. T n => n -> a -> Map n a -> Map n a AlignableMap.insert VarNum v Rule e do forall start varDoc altDoc a. Context start varDoc altDoc a -> T VarNum Rule ctxRules Context start varDoc altDoc a ctx }