$use Convert Lexer StdIO Stream;

$func Main = e;
Main =
  <WriteLn <ParseGrammarFile "samples.g">>;

$public $func ParseGrammarFile e.fname = e.grammar;
ParseGrammarFile e.fname =
  <ParseGrammar <File_Open e.fname>>;

$func ParseGrammar stream = e.grammar;
ParseGrammar stream =
  $iter <SkipBlanks stream> e.grammar <ParseProduction <Get_While stream &NotBlank>> :: e.grammar,
  <IsEnd_of_Stream stream> =
  e.grammar;

$func? NotBlank term = ;
NotBlank term = # <IsBlank term>;

$func? IsBlank term = ;
IsBlank \{ ' '; '\t'; '\n'; '\r'; };

$func SkipBlanks stream = ;
SkipBlanks stream = <Get_While stream &IsBlank> : e;

$func ParseProduction e.production = e.ast;
ParseProduction e.production =
  e.production : {
    '<' e.ident '>->' e.terms = (PROD <CheckIdentifier e.ident (e.production)> <ParseTerms e.terms (e.production)>);
    '[' e.ident ']->' e.terms = (NONTOKEN <CheckIdentifier e.ident (e.production)> <ParseTerms e.terms (e.production)>);
    v = $error "Invalid left part in the production " e.production;
    /*empty*/ = /*empty*/;
};

$func CheckIdentifier e.ident (e.production) = t.ast;
CheckIdentifier e.ident (e.production) =
  {
    <ScanIdentifier e.ident 0 0> : e () s s = (TYPE <ToWord e.ident>);
    $error "Invalid nonterminal name in the left part of the production " e.production;
  };

$func ParseTerms e.terms (e.production) = e.ast;
ParseTerms {
  e.term s.last '|' e.rest (e.production), # \{ s.last : '\\'; } =
    (<ParseItems e.term s.last (e.production)>) <ParseTerms e.rest (e.production)>;
  v.term (e.production) = (<ParseItems v.term (e.production)>);
  (e.production) = $error "Empty term in the production " e.production;
};

$func ParseItems e.items (e.production) = e.ast;
ParseItems {
  '<' e.ident '>' e.rest (e.production) =
    <CheckIdentifier e.ident (e.production)> <ParseItems e.rest (e.production)>;
  e.str s.last '<' e.ident '>' e.rest (e.production), # \{ s.last : '\\'; } =
    <ParseString e.str s.last (e.production)> <CheckIdentifier e.ident (e.production)> <ParseItems e.rest (e.production)>;
  v.str (e.production) = <ParseString v.str (e.production)>;
  (e) = /*empty*/;
};

$func ParseString e.str (e.production) = e.ast;
ParseString {
  (e) = /*empty*/;
  s.ch e.str (e.production) = s.ch : {
    '~' = () e.str;
    '\\' = e.str : {
      '|'  e.rest = ('|')  e.rest;
      '<'  e.rest = ('<')  e.rest;
      '>'  e.rest = ('>')  e.rest;
      '['  e.rest = ('[')  e.rest;
      ']'  e.rest = (']')  e.rest;
      '_'  e.rest = (' ')  e.rest;
      'n'  e.rest = ('\n') e.rest;
      'r'  e.rest = ('\r') e.rest;
      't'  e.rest = ('\t') e.rest;
      '~'  e.rest = ('~')  e.rest;
      '\\' e.rest = ('\\') e.rest;
      s1 s2 s3 e.rest,
        '01234567' : e s1 e,
        '01234567' : e s2 e,
        '01234567' : e s3 e =
        (<BytesToChars <ToInt s1 s2 s3>>) e.rest;
      e = $error "Invalid sequence after \\ in the production " e.production;
    };
    s = (s.ch) e.str;
  } :: (e.chars) e.rest =
    e.chars <ParseString e.rest (e.production)>;
};