module Language.Parser.Ptera.Pipeline.SRB2Parser where import Language.Parser.Ptera.Prelude import qualified Data.EnumMap.Strict as EnumMap import qualified Language.Parser.Ptera.Data.Alignable.Array as AlignableArray import qualified Language.Parser.Ptera.Data.HEnum as HEnum import qualified Language.Parser.Ptera.Data.Symbolic.IntMap as SymbolicIntMap 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 import qualified Language.Parser.Ptera.Runner.Parser as Parser import qualified Language.Parser.Ptera.Syntax as Syntax import qualified Language.Parser.Ptera.Syntax.Grammar as Grammar import qualified Unsafe.Coerce as Unsafe type Action ctx = Grammar.Action (Syntax.SemActM ctx) srb2Parser :: forall ctx tokens elem altHelp . Syntax.GrammarToken tokens elem => Proxy tokens -> SRB.T Int StringLit (Maybe altHelp) (Action ctx) -> Parser.T ctx elem altHelp srb2Parser :: forall ctx tokens elem altHelp. GrammarToken tokens elem => Proxy tokens -> T Int StringLit (Maybe altHelp) (Action ctx) -> T ctx elem altHelp srb2Parser Proxy tokens p T Int StringLit (Maybe altHelp) (Action ctx) srb = Parser.RunnerParser { $sel:parserInitial:RunnerParser :: Int -> Maybe Int parserInitial = \Int s -> coerce :: forall a b. Coercible a b => a -> b coerce do forall k a. Enum k => k -> EnumMap k a -> Maybe a EnumMap.lookup Int s do forall start varDoc altDoc a. SRB start varDoc altDoc a -> EnumMap start StateNum SRB.initials T Int StringLit (Maybe altHelp) (Action ctx) srb , $sel:parserGetTokenNum:RunnerParser :: elem -> Int parserGetTokenNum = \elem tok -> forall k (as :: [k]). HEnum as -> Int HEnum.unsafeHEnum do forall tokens elem. GrammarToken tokens elem => Proxy tokens -> elem -> T (TokensTag tokens) Syntax.tokenToTerminal Proxy tokens p elem tok , $sel:parserTrans:RunnerParser :: Int -> Int -> Trans parserTrans = \Int s0 Int t -> if Int s0 forall a. Ord a => a -> a -> Bool < Int 0 then Parser.Trans { $sel:transState:Trans :: Int transState = Int -1, $sel:transOps:Trans :: [TransOp] transOps = [] } else let srbSt :: MState srbSt = forall n a. T n => Array n a -> n -> a AlignableArray.forceIndex do forall start varDoc altDoc a. SRB start varDoc altDoc a -> Array StateNum MState SRB.states T Int StringLit (Maybe altHelp) (Action ctx) srb do Int -> StateNum SRB.StateNum Int s0 in Int -> MState -> Trans buildTrans Int t MState srbSt , $sel:parserAltKind:RunnerParser :: Int -> AltKind parserAltKind = \Int alt -> forall altDoc a. Alt altDoc a -> AltKind LAPEG.altKind do forall n a. T n => Array n a -> n -> a AlignableArray.forceIndex do forall start varDoc altDoc a. SRB start varDoc altDoc a -> T AltNum (Alt altDoc a) SRB.alts T Int StringLit (Maybe altHelp) (Action ctx) srb do Int -> AltNum LAPEG.AltNum Int alt , $sel:parserAction:RunnerParser :: Int -> ActionM ctx parserAction = \Int alt -> forall ctx. Action ctx -> ActionM ctx runAction do forall altDoc a. Alt altDoc a -> a LAPEG.altAction do forall n a. T n => Array n a -> n -> a AlignableArray.forceIndex do forall start varDoc altDoc a. SRB start varDoc altDoc a -> T AltNum (Alt altDoc a) SRB.alts T Int StringLit (Maybe altHelp) (Action ctx) srb do Int -> AltNum LAPEG.AltNum Int alt , $sel:parserStateHelp:RunnerParser :: Int -> [(Int, Int)] parserStateHelp = \Int s -> let srbSt :: MState srbSt = forall n a. T n => Array n a -> n -> a AlignableArray.forceIndex do forall start varDoc altDoc a. SRB start varDoc altDoc a -> Array StateNum MState SRB.states T Int StringLit (Maybe altHelp) (Action ctx) srb do Int -> StateNum SRB.StateNum Int s in [AltItem] -> [(Int, Int)] buildStateHelp do MState -> [AltItem] SRB.stateAltItems MState srbSt , $sel:parserAltHelp:RunnerParser :: Int -> (StringLit, Maybe altHelp) parserAltHelp = \Int alt -> let vn :: VarNum vn = forall altDoc a. Alt altDoc a -> VarNum LAPEG.altVar do forall n a. T n => Array n a -> n -> a AlignableArray.forceIndex do forall start varDoc altDoc a. SRB start varDoc altDoc a -> T AltNum (Alt altDoc a) SRB.alts T Int StringLit (Maybe altHelp) (Action ctx) srb do Int -> AltNum LAPEG.AltNum Int alt v :: Var StringLit v = forall n a. T n => Array n a -> n -> a AlignableArray.forceIndex do forall start varDoc altDoc a. SRB start varDoc altDoc a -> T VarNum (Var varDoc) SRB.vars T Int StringLit (Maybe altHelp) (Action ctx) srb do VarNum vn in (forall varDoc. Var varDoc -> varDoc PEG.varHelp Var StringLit v, forall a. Maybe a Nothing) } buildTrans :: Int -> SRB.MState -> Parser.Trans buildTrans :: Int -> MState -> Trans buildTrans Int t MState srbSt = case forall a. Int -> IntMap a -> Maybe a SymbolicIntMap.lookup Int t do MState -> IntMap Trans SRB.stateTrans MState srbSt of Maybe Trans Nothing -> Parser.Trans { $sel:transState:Trans :: Int transState = Int -1, $sel:transOps:Trans :: [TransOp] transOps = [] } Just (SRB.TransWithOps [TransOp] ops (SRB.StateNum Int s1)) -> Parser.Trans { $sel:transState:Trans :: Int transState = Int s1, $sel:transOps:Trans :: [TransOp] transOps = TransOp -> TransOp transOp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [TransOp] ops } Just (SRB.TransReduce (LAPEG.AltNum Int alt)) -> Parser.Trans { $sel:transState:Trans :: Int transState = Int -1, $sel:transOps:Trans :: [TransOp] transOps = [Int -> TransOp Parser.TransOpReduce Int alt] } buildStateHelp :: [SRB.AltItem] -> [(Parser.AltNum, Int)] buildStateHelp :: [AltItem] -> [(Int, Int)] buildStateHelp [AltItem] altItems = [ ( coerce :: forall a b. Coercible a b => a -> b coerce do AltItem -> AltNum SRB.altItemAltNum AltItem altItem , coerce :: forall a b. Coercible a b => a -> b coerce do AltItem -> Position SRB.altItemCurPos AltItem altItem ) | AltItem altItem <- [AltItem] altItems ] transOp :: SRB.TransOp -> Parser.TransOp transOp :: TransOp -> TransOp transOp = \case SRB.TransOpEnter (LAPEG.VarNum Int v) Bool needBack Maybe StateNum mEnterSn -> let enterSn :: Int enterSn = case Maybe StateNum mEnterSn of Maybe StateNum Nothing -> Int -1 Just (SRB.StateNum Int x) -> Int x in Int -> Bool -> Int -> TransOp Parser.TransOpEnter Int v Bool needBack Int enterSn SRB.TransOpPushBackpoint (SRB.StateNum Int backSn) -> Int -> TransOp Parser.TransOpPushBackpoint Int backSn SRB.TransOpHandleNot (LAPEG.AltNum Int alt) -> Int -> TransOp Parser.TransOpHandleNot Int alt TransOp SRB.TransOpShift -> TransOp Parser.TransOpShift runAction :: Action ctx -> Parser.ActionM ctx runAction :: forall ctx. Action ctx -> ActionM ctx runAction (Grammar.Action (Syntax.SemActM HList us -> ActionTask ctx a f)) = forall ctx. ([ReduceArgument] -> ActionTask ctx ReduceArgument) -> ActionM ctx Parser.ActionM \[ReduceArgument] l -> forall a. a -> ReduceArgument Parser.ReduceArgument forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> HList us -> ActionTask ctx a f do forall {us2 :: [*]}. [ReduceArgument] -> HList us2 goL [ReduceArgument] l where goL :: [ReduceArgument] -> HList us2 goL = \case [] -> forall (us1 :: [*]) (us2 :: [*]). HList us1 -> HList us2 unsafeCoerceHList HList '[] Syntax.HNil Parser.ReduceArgument a x:[ReduceArgument] xs -> forall (us1 :: [*]) (us2 :: [*]). HList us1 -> HList us2 unsafeCoerceHList do a x forall u (us :: [*]). u -> HList us -> HList (u : us) Syntax.:* [ReduceArgument] -> HList us2 goL [ReduceArgument] xs unsafeCoerceHList :: Syntax.HList us1 -> Syntax.HList us2 unsafeCoerceHList :: forall (us1 :: [*]) (us2 :: [*]). HList us1 -> HList us2 unsafeCoerceHList = forall a b. a -> b Unsafe.unsafeCoerce