regex EscChar                   = '\\' | '/' | 'b' | 'f' | 'n' | 'r'| 't' | 'u' HexDigit HexDigit HexDigit HexDigit
    {
      regex HexDigit                  = ['0'..'9', 'a'..'f', 'A'..'F'];
    }

      regex Quote   = '\"';
      regex Esc     = '\\' (Quote | EscChar);
      regex Escs    = Esc+;
      regex NotEscs = Any+ - (Any* (Quote | '\\' | NewLine) Any*);

    public Xor(fsm1 : FSM, fsm2 : FSM) : FSM
    {
      Product([fsm1, fsm2], fun(([ok1, ok2])) { set => set.Contains(ok1) ^ set.Contains(ok2) })
    }

    public Sub(fsm1 : FSM, fsm2 : FSM) : FSM
    {
      Product([fsm1, fsm2], fun(([ok, fail])) { set => set.Contains(ok) && !set.Contains(fail) })
    }

    public Product(fsms : list[FSM], makeIsOkState : list[int] -> (Set[int] -> bool)) : FSM
    {
      def (result, resultStart) = FSM().NewStartState();
      def (result, resultOkStates) = fsms.Fold((result, []), (fsm, (result, resultOkStates)) =>
      {
        def (result, fsmStart, fsmOkStates) = result.IncludeFSM(fsm);
        def (result, fsmOkState) = result.NewState();
        def result = result.AddTransition(Transition.Epsilon(resultStart, fsmStart));
        def result = fsmOkStates.Fold(result, (okState, result) => result.AddTransition(Transition.Epsilon(okState, fsmOkState)));
        (result, fsmOkState :: resultOkStates);
      });
      MakeDeterministic(result, makeIsOkState(resultOkStates.Reverse()))
    }

Если для разборы бинарного формата нужен генератор парсеров, то это означает что формат придумывал конченый неадекват.

rule decdigits = ('0' |.. '9')+;
lexem decnum = decdigits;
lexem floatnum = decnum '.' {decnum} | '.' decnum;

V>Это примерно такая же работа, как в языке расширенных регулярных выражений отличать конечные правила от промежуточных.
Что за бред опять?

...
WH>

    precedence Additive:
    | add        = expr sm '+' sm expr { override Value = Expr1.Value() + Expr2.Value(); }
    | sub        = expr sm '-' sm expr { override Value = Expr1.Value() - Expr2.Value(); }

    precedence Multiplicative:
    | mul        = expr sm '*' sm expr { override Value = Expr1.Value() * Expr2.Value(); }
    | div        = expr sm '/' sm expr { override Value = Expr1.Value() / Expr2.Value(); }
    | mod        = expr sm '%' sm expr { override Value = Expr1.Value() % Expr2.Value(); }

    precedence Power:
    | pow        = expr sm '^' sm expr right-associative
                                       { override Value = System.Math.Pow(Expr1.Value(), Expr2.Value()); }

    precedence Unary:
    | neg        = '-' expr            { override Value = -Expr.Value(); }

input    ::= ws expr ws eoi;

expr    ::= ws powterm [{ws '^' ws powterm}];
powterm    ::= ws factor [{ws ('*'|'/') ws factor}];
factor    ::= ws term [{ws ('+'|'-') ws term}];
term    ::= '(' ws expr ws ')' | '-' ws expr | number;

V>Мне надо честный choice.

V>Ну так в другой раз переспроси, если некая терминология не понятна, а не накидывайся сходу.

V>Т.е. ты этого не знал, но опять бежишь на меня наезжать.

It is sufficiently fast and does not require much memory. This is the fastest implementation of the Earley parser which I know of. If you know a faster one, please send me a message. It can parse 300K lines of C program per second on modern computers and allocates about 5MB memory for 10K line C program.

LR parsers can be made to run 6 to 10 times as fast as the best table-interpretive LR parsers.

We can avoid computing any of these intermediate results multiple times by storing them in a table. The table has one row for each of the four parse functions and one column for each distinct position in the input string. We fill the table with the results of each parse function for each input position, starting at the right end of the input string and working towards the left, column by column.

pAdditive d = alt1 where
-- Additive <- Multitive ’+’ Additive
  alt1 = case dvMultitive d of
    Parsed vleft d’ ->
      case dvChar d’ of
        Parsed ’+’ d’’ ->
          case dvAdditive d’’ of
            Parsed vright d’’’ ->
              Parsed (vleft + vright) d’’’
              _ -> alt2
            _ -> alt2
        _ -> alt2

As Pepper points out [17], LR parsing can be viewed simply as LL parsing with the grammar rewritten so as to eliminate left recursion and to delay all important parsing decisions as long as possible. The result is that LR provides more flexibility in the way grammars can be expressed, but no actual additional recognition power.

Это фатальный недостаток для промышленного использования.

V>Наша песня хороша, начинай сначала?

    precedence Choice:
    | Choice                  = LeftRule=RegexExpression ^ Choice sm RightRules=("|" RegexExpression ^ Choice)+
    
    precedence Sequence:
    | Sequence                = LeftRule=RegexExpression ^ Sequence sm RightRules=(RegexExpression ^ Sequence)+

WH>>

V>>>Ну так в другой раз переспроси, если некая терминология не понятна, а не накидывайся сходу.

V>И это говорит тот, кто постоянно обвиняет в непонимании других?

V>Как так?

    void RelOp(out Op op) {
        op = Op.EQU; 
        if (la.kind == 14) {
            Get();
        } else if (la.kind == 15) {
            Get();
            op = Op.LSS; 
        } else if (la.kind == 16) {
            Get();
            op = Op.GTR; 
        } else SynErr(30);
    }

    void Factor(out int type) {
        int n; Obj obj; string name; 
        type = undef; 
        if (la.kind == 1) {
            Ident(out name);
            obj = tab.Find(name); type = obj.type;
            if (obj.kind == var) {
            if (obj.level == 0) gen.Emit(Op.LOADG, obj.adr);
            else gen.Emit(Op.LOAD, obj.adr);
                         } else SemErr("variable expected"); 
        } else if (la.kind == 2) {
            Get();
            n = Convert.ToInt32(t.val); 
            gen.Emit(Op.CONST, n); type = integer; 
        } else if (la.kind == 4) {
            Get();
            Factor(out type);
            if (type != integer) {
             SemErr("integer type expected"); type = integer;
            }
            gen.Emit(Op.NEG); 
        } else if (la.kind == 5) {
            Get();
            gen.Emit(Op.CONST, 1); type = boolean; 
        } else if (la.kind == 6) {
            Get();
            gen.Emit(Op.CONST, 0); type = boolean; 
        } else SynErr(31);
    }

int ParseSomeRule(int startPos, string text)
{
  int newPos;
  if (memoize.TryGetValue(new Key(SomeRuleID, startPos), out newPos))
    return newPos;

  //Разбор

  memoize.Add(new Key(SomeRuleID, startPos), newPos);
  return newPos;
}

  newPos = -1;

  if (newPos < 0)
    newPos = ParseSomeRuleAlternative1(startPos, text);

  if (newPos < 0)
    newPos = ParseSomeRuleAlternative2(startPos, text);

  if (newPos < 0)
    newPos = ParseSomeRuleAlternative3(startPos, text);

  if (newPos < 0)
    newPos = ParseSomeRuleAlternative4(startPos, text);

  if (newPos < 0)
    newPos = ParseSomeRuleAlternative5(startPos, text);

  if (newPos < 0)
    newPos = ParseSomeRuleAlternative6(startPos, text);

newPos = startPos;
newPos = ParseSome1(newPos, text);
if (newPos >= 0)
{
    newPos = ParseSome2(newPos, text);
    if (newPos >= 0)
    {
        newPos = ParseSome3(newPos, text);
        if (newPos >= 0)
        {
            newPos = ParseSome4(newPos, text);
            if (newPos >= 0)
            {
                newPos = ParseSome5(newPos, text);
            }
        }
    }
}

int
yaep_read_grammar (struct grammar *g, int strict_p,
           const char *(*read_terminal) (int *code),
           const char *(*read_rule) (const char ***rhs,
                         const char **abs_node,
                         int *anode_cost,
int **transl))

WH>>int
WH>>yaep_read_grammar (struct grammar *g, int strict_p,
WH>>           const char *(*read_terminal) (int *code),
WH>>           const char *(*read_rule) (const char ***rhs,
WH>>                         const char **abs_node,
WH>>                         int *anode_cost,
WH>>int **transl))
WH>>

This is part of YAEP (Yet Another Earley Parser) implementation; you can
redistribute it and/or modify it under the terms of the GNU General
Public License as published by the Free Software Foundation; either
version 2, or (at your option) any later version.

{-# LANGUAGE PolyKinds, DataKinds, TypeFamilies, GADTs #-}
{-# LANGUAGE TypeOperators, NPlusKPatterns #-}
{-# LANGUAGE DeriveFoldable, StandaloneDeriving, TypeApplications #-}
{-# LANGUAGE TemplateHaskell #-} 

import Data.Singletons
import Data.Singletons.TH

import Text.Read (readMaybe)
import Data.Kind (Type)
import qualified Data.Foldable as F

data Nat = Z | S Nat deriving Show

intToNat 0 = Z
intToNat (n + 1) = S (intToNat n)

genSingletons [''Nat]

-- генерирует синглетоны для Nat:

-- data instance Sing (n :: Nat) where
--     SZ :: Sing Z
--     SS :: Sing n -> Sing (S n)

-- instance SingKind Nat where
--     type DemoteRep Nat = Nat

--     fromSing SZ = Z
--     fromSing (SS b) = S (fromSing b)

--     toSing Z = SomeSing SZ
--     toSing (S b) = case toSing b :: SomeSing Nat of
--           SomeSing c -> SomeSing (SS c)

data Vect :: Nat -> Type -> Type where
   V0 :: Vect Z x
   (:>) :: x -> Vect n x -> Vect (S n) x

deriving instance Foldable (Vect n) 

infixr 5 :>

getInt :: IO Int
getInt = do
  resp <- getLine
  case readMaybe @Int resp of
     Just value -> pure value
     Nothing -> do
       putStrLn "error"
       getInt

makeVect :: Sing (size :: Nat) -> a -> Vect size a
makeVect SZ _ = V0
makeVect (SS x) v = v :> makeVect x v

zipVect :: Vect size a -> Vect size b -> Vect size (a, b)
zipVect V0 V0 = V0
zipVect (x1 :> v1) (x2 :> v2) = (x1, x2) :> zipVect v1 v2

main :: IO ()
main = do
  putStrLn "Hello world"
  size <- getInt
  -- нету "голых" экзистенциальных типов, 
  -- работать с синглетоном числа придется только в континьюэйшене
  withSomeSing (intToNat size) $ \ssize -> do
    let vect1 = makeVect ssize size
    let vect2 = makeVect ssize "^_^"
    -- let vect2 = makeVect (SS ssize) "^_^" -- вызовет ошибку
    print . F.toList $ vect1
    print . F.toList $ vect2
    print . F.toList $ zipVect vect1 vect2