парсер

$EXTERN Lexer, Put, Arg, Open;

$ENTRY Go {
  = <Open 'w' 2 <Arg 2>><Put 2 <Parser : <Lexer <Arg 1>>>>;
}
Parser {
  : eTokens =
    <Program
      () /* список ошибок */
      () /* список функций */
      : eTokens
    >;
}

/*
Program =
  [$ENTRY] Name FunctionBody Program
  | $EXTERN ExternList Program
  | пусто .
*/

Program {
  tErrorList tFunctions (Directive tPosDir 'ENTRY') (Name tPosName : eName) : eTokens =
    <Program-Function
      tFunctions eName tPosName Entry
      <FunctionBody tErrorList ()() : eTokens>
    >;

  tErrorList tFunctions (Directive tPosDir 'ENTRY') tOtherToken : eTokens =
  <Program
    /* Добавляет сообщение */
    /* «позиция: unexpected token токен, expected function name» */
    /* Позиция и значение неожиданного токена выбирается из tOtherToken */
    <AddUnexpectedToken tErrorList tOtherToken 'function name'>
    tFunctions tOtherToken : eTokens
  >;

  tErrorList tFunctions (Name tPos : eName) : eTokens =
    <Program-Function
      tFunctions eName tPos Local
      <FunctionBody tErrorList : eTokens>
    >;

  tErrorList tFunctions (Directive tPos 'EXTERN') : eTokens =
    <ExternList tErrorList tFunctions : eTokens>;

  tErrorList tFunctions (EOF tPos '!') =
    /* Корректное завершение */
    <SemanticAnalysis tErrorList <Reverse tFunctions>>; /* REVERSE */

  tErrorList tFunctions tOtherToken : eTokens =
    <Program
      <AddUnexpectedToken
        tErrorList tOtherToken 'function definion or $EXTERN'
      >
      tFunctions : eTokens
    >;
}

FunctionBody {
  tErrorList (OpenBlock tposOpenBlock '{') : eTokens = 
    <Pattern tErrorList () () () : eTokens >; 
    
  tErrorList token : eTokens = 
    <Pattern <AddExpectedCharacter tErrorList token 'open function body'> () () () token : eTokens >; /* ErrorList Sentences Stack Scanned :Terms */
}

AddToken {
  tPattern eToken =
    tPattern : eToken; /* раз такой порядок, значит не нужно будет делать reverse */
}

/* ErrorList Sentences Stack Scanned :eTerms */
Pattern {
  errorList sentences openBrackets eScanned (Name posName : eName) : eTokens =
    <Pattern errorList sentences openBrackets ((Name posName : eName) :eScanned)>;
    
  errorList sentences openBrackets eScanned (Char posChar : eChar) : eTokens =
    <Pattern errorList sentences openBrackets ((Char posChar : eChar) : eScanned) : eTokens>;
  
  errorList sentences openBrackets eScanned (Number posNumber : eNumber) : eTokens =
    <Pattern errorList sentences openBrackets ((Number posNumber : eNumber) : eScanned) : eTokens>;
    
  errorList sentences openBrackets eScanned (Variable posVariable : eVariable) : eTokens =
    <Pattern errorList sentences openBrackets ((Variable posVariable : eVariable) : eScanned) : eTokens>;    

  errorList sentences openBrackets eScanned (OpenBracket posBracket '(') : eTokens =
    <Pattern errorList sentences ((OpenBracket posBracket '(') : eScanned) ()  : eTokens >;
    
  errorList sentences (eScanned : eOpenBrackets) inBrackets (CloseBracket posBracket ')') : eTokens =
    <Pattern errorList sentences eOpenBrackets (<ReverseCheckColon inBrackets> : eScanned) : eTokens >;
  

    
  /* Если образец закончился, то есть мы встретили '=' и стек пуст: ()
    значит начинаем разбирать результат */    
  errorList sentences () scanned (Assign posAssgn '=') : eTokens =
    <Result errorList sentences <Reverse scanned> () () : eTokens >; /* вызываем Result и ждем пока обработается результат, чтоб все это прикрепить к предложениям */
    
  errorList eSentences () (CloseBlock posCloseBlock '}') : eTokens =
    <CompleteFunclion errorList eSentences : eTokens >;  
}

Result {
  
  errorList sentences pattern openBrackets eScanned (Name posName : eName) : eTokens =
    <Result errorList sentences pattern openBrackets ((Name posName : eName) : eScanned) : eTokens>;
    
  errorList sentences pattern openBrackets eScanned (Char posChar : eChar) : eTokens =
    <Result errorList sentences pattern openBrackets ((Char posChar : eChar) : eScanned) : eTokens>;
  
  errorList sentences pattern openBrackets eScanned (Number posNumber : eNumber) : eTokens =
    <Result errorList sentences pattern openBrackets ((Number posNumber : eNumber) : eScanned) : eTokens>;
    
  errorList sentences pattern openBrackets eScanned (Variable posVariable : eVariable) : eTokens =
    <Result errorList sentences pattern openBrackets ((Variable posVariable : eVariable) : eScanned) : eTokens>;
    
  errorList sentences pattern openBrackets eScanned (OpenBracket posBracket '(') : eTokens =
    <Result errorList sentences ((OpenBracket posBracket '(') : eScanned) : eTokens >;
    
  errorList sentences pattern (eScanned : eOpenBrackets) inBrackets (CloseBracket posBracket ')') : eTokens =
    <Pattern errorList sentences pattern eOpenBrackets (<ReverseCheckColon inBrackets> : eScanned) : eTokens >;
  
  
  errorList eSentences pattern () scanned (Semicolon posSemicolon ';') : eTokens =
    <Pattern errorList ((pattern <Reverse scanned>) : eSentences) () : eTokens >;
}

CompleteFunclion {
  errorList sentences : eTokens = 
    errorList <Reverse sentences> : eTokens;
}

ReverseCheckColon {
  errorList( term (Colon pos ':') :eTerms) = 
    <DoReverseCheck errorList eTerms (LAST term)>;
  errorList terms = <DoReverseCheck errorList terms (NIL)>;
}

DoReverseCheck {
  errorList ((Colon pos ':') : eTerms) reversed =
    <DoReverseCheck
      <AddUnexpectedToken errorList (Colon pos ':') 'colon'>
      eTerms
      reversed
    >;
  (term : eTerms) eReversed = 
    <DoReverseCheck eTerms (term : eReversed)>;
  () reversed = reversed;
}

Reverse {
  (term :eTerms) = 
    <DoReverse eTerms (LAST term)>;
  terms = <DoReverse terms (NIL)>;  
}

DoReverse {
  (term : eTerms) eReversed = 
    <DoReverse eTerms (term : eReversed)>;
  () reversed = reversed;
}

ParseResult {
  tErrorList tPattern tResult (Char tCharPos tChar) : eTokens = 
    <ParseResult tErrorList  tPattern   <AddToken tResult (Char tChar)> : eTokens >;
  
  /*---- other tokens ----*/
 
  tErrorList tPattern tResult (CloseBlock tposCloseBlock ';') : eTokens = 
    <FunctionBody tErrorList  tPattern tResult  : eTokens >;
  
  tErrorList tPattern tResult (CloseBlock tposCloseBlock '}') : eTokens = 
    tErrorList (tPattern tResult) : eTokens;
}

Program-Function {
  eFunctions tName tPos sAccess
  tErrorList tFunctionBody : eTokens =
  <Program
    tErrorList
    ((tName sAccess tPos tFunctionBody) : eFunctions) /* PUSH */
    : eTokens
  >;
}

/*
ExternList = FunctionName "," ExternList | ";"
*/

ExternList {
  tErrorList eFunctions (Name tPosName tName) (Comma tPosComma ',') : eTokens =
  <ExternList
    tErrorList
    ((tName Entry tPosName NoBody) : eFunctions) /* PUSH */
    : eTokens
  >;

tErrorList tFunctions (Semicolon tPos ';') : eTokens =
  <Program tErrorList tFunctions : eTokens>;

/*тут ещё будет обработка ошибок (нет имени, нет запятой, внезапный EOF, нет точки с запятой)*/
}

SemanticAnalysis {
  errorList functions = errorList functions;
}

AddUnexpectedToken {
  errorList token : eMessage = 
    ((token : eMessage) : errorList);
}

AddExpectedCharacter {
  errorList token : eMessage = 
    ((token : eMessage) : errorList);
}