//
// Copyright (C) 1999, 2000 Refal+ Development Group
//
// Refal+ is free software; 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 of the License, or
// (at your option) any later version.
//
// Refal+ is distributed in the hope that it will be useful,
// but WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
// GNU General Public License for more details.
//
// You should have received a copy of the GNU General Public License
// along with Refal+; if not, write to the Free Software
// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
//
// $Source$
// $Revision$
// $Date$
// Author: Andrey Slepuhin <pooh@msu.ru>

// rfp_parse.rfi
$use "rfpc" ; // rfpc.rfi
$use "rfp_helper" ; // rfp_helper.rfi
$use "rfp_src" ; // rfp_src.rfi
$use "rfp_err" ; // rfp_err.rfi

$use Box ;
$use Convert ;
$use Compare ;
$use Table ;
$use StdIO ;
$use Arithm ;
$use Access ;

$func Parse-Body = e.items ;
$func Parse-Const-Decls = e.items ;
// $func Parse-Const-Decl e.name = e.items ;
$func Parse-Const-Expr = e.expr ;
$func Parse-Const-Term (e.pos) (s.type e.value) = e.term ;
$func Module-Name = e.name ;
$func Parse-Object-Decls s.type  = e.items ;
$func Parse-Extern-Names = e.extern-decls;
$func Parse-Func-Decl s.type = e.items ;
$func Parse-Trace-Names = e.trace-directives ;
$func Parse-Func-Def (e.pos) (s.type e.value) = e.items ;
// $func Full-Name s.idx (e.name) = e.fullname ;
$func? Lookup-Name (e.pos) (e.name) = e.fullname ;
$func Lookup-Check (e.pos) (e.name) (e.fullname) (e.rest) = ;
$func Bind-Name (e.name) ((e.pos) e.info) = ;
$func? Get-Token = (e.pos) (s.type e.value) ;
$func Unget-Token e.token = ;
$func? Expect-Token e.types = (e.pos) (s.type e.value) ;
$func Token-Descr s.type = e.string ;
$func Parse-Format = e.format ;
$func Parse-Format-Terms = e.terms ;
$func Parse-Result = e.format ;
$func Parse-Result-Term = e.terms ;
$func Parse-Hard-Expr = e.format ;
$func Parse-Hard-Expr-Terms = e.terms ;
$func Parse-Sentence e.colon-pos = e.items ;
$func Parse-Pattern e.colon-pos = e.items ;
$func Parse-Pattern-Expr = e.items ;
$func Parse-Pattern-Term = e.items ;
$func Parse-Ref = e.items ;
$func? Tail? = ;
$func Parse-Path = e.items ;
$func Parse-Source = e.items ;
$func Parse-Tail = e.items ;
$func Parse-Alt e.colon-pos = e.items ;
$func Make-Name2 e.sname = e.name ;
$func Parse-Imports = e.imports ;
$func? Interface? = ;
$func Canonical-Name s.type e.name = e.name;
$func Canonical-Word e.value = s.word;
$func Pragma e.pos = (PRAGMA e.PragmaBody);

$box Module-Name-Box ;
$box Saved-Position ;
$box Unget-Stack ;
$table Constants ;
$table Names ;

$box Traceall? ;

// This function returns a token description according
// to its type
Token-Descr // s.type = e.string
{
  COMMA = "\',\'";
  COLON = "\':\'";
  DCOLON = "\'::\'";
  SEMICOLON = "\';\'";
  LBRACE = "'{'";
  RBRACE = "'}'";
  LBRACKET = "'<'";
  RBRACKET = "'>'";
  LPAREN = "'('";
  RPAREN = "')'";
  REF = "'&'";
  NOT = "'#'";
  EQUAL = "'='";
  EOF = "end of file";
  EVAR = "e-variable";
  VVAR = "v-variable";
  TVAR = "t-variable";
  SVAR = "s-variable";
  BOX = "$box";
  TABLE = "$table";
  VECTOR = "$vector";
  STRING = "$string";
  FUNC = "$func";
  FUNC? = "$func?";
  TFUNC = "$tfunc";
  EXTERN = "$extern";
  CHANNEL = "$channel";
  USE = "$use";
  TRACE = "$trace";
  TRACEALL = "$traceall";
  s.type = "token " s.type;
};

// This function returns a next token
Get-Token // [] = (e.pos) (s.type e.value)
 = {
   // First check if there are any tokens in unget stack
   <? &Unget-Stack> : (e.tokens) ((e.pos) (s.type e.value)) =
     <Store &Unget-Stack e.tokens>, (e.pos) (s.type e.value);
   // If unget stack is empty, get a token in a usual way
   <? &RFP-Token-Stack> : (e.token) e.rest,
     <Store &RFP-Token-Stack e.rest> = e.token : (e.pos) (s.type e.value),
     (e.pos) (s.type e.value);
 };

// This function puts a token to unget stack for future use
Unget-Token // e.token = []
  e.token =
    <Store &Unget-Stack (<? &Unget-Stack>) (e.token)>;

// This function scans for a token of one of specified types
Expect-Token // e.types = (e.pos) (s.type e.value)
  e.types =
    T <Get-Token> $iter \{
      \{
        s.message : T;
        s.type : EOF;
      }, <RFP-Error (e.pos) ("Unexpected " <Token-Descr s.type>)>, $fail;
      F <Get-Token>;
    } :: s.message (e.pos) (s.type e.value),
      e.types :
        \{
           e s.type e =
//<WriteLN "Expect: got " s.type e.value>,
             (e.pos) (s.type e.value);
           e EMPTY e =
//<WriteLN "Expect: got " EMPTY>,
             <Unget-Token (e.pos) (s.type e.value)>, (e.pos) (EMPTY);
        };

RFP-Parser =
  <RFP-Clear-Table &Constants>,
  <RFP-Clear-Table &Names>,
  <Store &Unget-Stack>,
  <Store &Module-Name-Box <RFP-Module-Name <Lookup &RFP-Sources 1>>>,
//  $trap
    {
      <Interface?>,
        (INTERFACE <Make-Name <Module-Name>> <Parse-Body>);
      (MODULE <Make-Name <Module-Name>> <Parse-Body>);
    }
//  $with {
//    e = <? &Saved-Position> :: e.pos,
//      <RFP-Error (e.pos) ("Unexpected end of file during declaration parsing")>,
//      FAIL;
//  };
  ;

// This is a shortcut function to get a module name
Module-Name = <? &Module-Name-Box>;

Interface?
  = <RFP-Source-File-Name 1> : e '.rfi';

// The main parsing routine
Parse-Body =
{
  <Expect-Token
    BOX TABLE VECTOR STRING CHANNEL CONST WORD QWORD FUNC FUNC? TFUNC EXTERN USE TRACE TRACEALL EOF
  > :: (e.pos) (s.type e.value),
    <Store &Saved-Position e.pos>,
    \{
      // If token type is BOX, TABLE, VECTOR, STRING or CHANNEL
      // then parse object declaration
      s.type :
        \{
          BOX;
          TABLE;
          VECTOR;
          STRING;
          CHANNEL;
        } = <Parse-Object-Decls s.type>;
      s.type : USE =
        <Parse-Imports>;
      // If token type is CONST then parse constant declaration
      s.type : CONST =
        <Parse-Const-Decls>;
      s.type : TRACE =
        <Parse-Trace-Names>;
      s.type : TRACEALL =
        <Store &Traceall? TRACEALL>,
        <Expect-Token SEMICOLON EMPTY> : e;
      s.type : EXTERN =
        <Parse-Extern-Names>;
      s.type :
        \{
          FUNC;
          FUNC?;
          TFUNC;
        } = <Parse-Func-Decl s.type>;
      s.type :
        \{
          WORD;
          QWORD;
        } = <Parse-Func-Def (e.pos) (s.type e.value)>;
      # \{ s.type : EOF; } ;
    } :: e.items = e.items <Parse-Body>;
  // If there are no tokens and we aren't processing an interface file then
  // check for undefined functions.
  <Interface?> = ;
  <Domain &Names> (/*e.undefs*/) $iter {
    e.domain : e (e.name) e.rest,
      <Lookup &Names e.name> : (e.decl-pos) (e.decl-name) s.tag s.linkage t.in t.out,
      s.linkage : \{ LOCAL; EXPORT; } =
      <RFP-Warning (e.decl-pos) ("No defenition for the function '" e.name "'")>,
      e.rest
      (e.undefs (UNDEF s.tag <Pragma e.decl-pos> <Make-Name e.decl-name> t.in t.out));
    /*empty*/ (e.undefs);
  } :: e.domain (e.undefs),
    e.domain : /*empty*/ =
    e.undefs;
};

Parse-Imports // [] = e.imports
  = <Expect-Token WORD QWORD SEMICOLON>
    :: (e.pos) (s.type e.value),
    {
      s.type : SEMICOLON;
      (USE <Make-Name e.value>) <Parse-Imports>;
    };

Parse-Object-Decls s.type =
{
  <Expect-Token WORD QWORD SEMICOLON> :
    {
      (e) (SEMICOLON) = ;
      (e.pos) (s.WORD-or-QWORD e.name) = e.pos :
        {
          s S s s = LOCAL (<Module-Name>);
          s.idx e = {
            <RFP-Module-Name <Lookup &RFP-Sources s.idx>>
              :: e.module,
              <"/=" (e.module) (<Module-Name>)>, IMPORT (e.module);
            EXPORT (<Module-Name>);
          };
        } :: s.linkage (e.module),
        e.module '.' e.name :: e.name,
        <Bind-Name
          (<Canonical-Name s.WORD-or-QWORD e.name>)
          ((e.pos) (e.name) s.type)>,
        (s.linkage s.type <Pragma e.pos> <Make-Name e.name>)
        <Parse-Object-Decls s.type>;
    };
};

Parse-Const-Expr
  = <Expect-Token REF SYMBOLS NUMBER WORD QWORD LPAREN EMPTY>
    :: (e.pos) (s.type e.value),
    {
      s.type : EMPTY = ;
      <Parse-Const-Term (e.pos) (s.type e.value)> <Parse-Const-Expr>;
    };

Parse-Const-Term (e.pos) (s.type e.value) =
  s.type :
  {
    REF = <Parse-Ref>;
    SYMBOLS = e.value;
    NUMBER = e.value;
    WORD = <Canonical-Word e.value>;
    QWORD = <To-Word e.value>;
    LPAREN = <Parse-Const-Expr> :: e.expr,
      <Expect-Token RPAREN> : e, (PAREN e.expr);
  };

Parse-Const-Decls
  = <Expect-Token WORD QWORD SEMICOLON COMMA> :: (e.pos) (s.type e.value),
    s.type :
      {
        SEMICOLON = ;
        COMMA = <Parse-Const-Decls> ;
        s.WORD-or-QWORD =
          <Expect-Token EQUAL> : e,
            <Parse-Const-Expr> :: e.expr,
            e.pos :
              {
                s S s s = LOCAL (<Module-Name>);
                s.idx e = {
                  <RFP-Module-Name <Lookup &RFP-Sources s.idx>>
                  :: e.module,
                    <"/=" (e.module) (<Module-Name>)>, IMPORT (e.module);
                  EXPORT (<Module-Name>);
                };
              } :: s.linkage (e.module),
              e.module '.' e.value :: e.name,
              <Bind-Name
                (<Canonical-Name s.WORD-or-QWORD e.name>)
                ((e.pos) (e.name) CONST)>,
              (s.linkage CONST <Pragma e.pos> <Make-Name e.name> e.expr)
              <Parse-Const-Decls>;
//            <Parse-Const-Decl <Full-Name s.idx (e.value)>>;
      };

/*
Parse-Const-Decl e.name =
  <Expect-Token EQUAL> : e,
  <Parse-Const-Expr> :: e.expr,
  <Bind &Names (e.name) (CONST e.expr)>,
  (CONST <Make-Name e.name> e.expr) <Parse-Const-Decls>;

Full-Name s.idx (e.name) =
  <RFP-Module-Name <Lookup &RFP-Sources s.idx>> '.' e.name;
*/

Lookup-Name (e.pos) (e.name) =
  <Domain &Names> :
    \{
      e (e.name) e.rest = (e.name) (e.rest);
      e (e.module '.' e.name) e.rest =
        (e.module '.' e.name) (e.rest);
    } :: (e.fullname) (e.rest),
    <Lookup-Check (e.pos) (e.name) (e.fullname) (e.rest)>,
    e.fullname;

Lookup-Check (e.pos) (e.name) (e.fullname) (e.names) =
  {
    e.names :
      \{
        e (e.name) e.rest = (e.name) (e.rest);
        e (e.module '.' e.name) e.rest = (e.module '.' e.name) (e.rest);
      } :: (e.other) (e.rest),
      <RFP-Error (e.pos)
        ("Ambiguous name \'" e.name "\' - both \'"
         e.fullname "\' and \'"
         e.other "\' do exist")>,
      <Lookup-Check (e.pos) (e.name) (e.fullname) (e.rest)>;;
  };

Bind-Name (e.name) ((e.pos) e.info) =
  {
    <Lookup &Names e.name> : (e.prev-pos) e =
      <RFP-Error (e.pos) ("Redeclaration of '" e.name "',")>,
      <RFP-Error (e.prev-pos) ("  previously declared here")>;;
  },
  <Bind &Names (e.name) ((e.pos) e.info)>;

Parse-Extern-Names =
  <Expect-Token WORD QWORD SEMICOLON> : {
    e (SEMICOLON) = ;
    (e.pos) (s.type e.value) =
      <Bind-Name
        (<Canonical-Name s.type e.value>)
        ((e.pos) (e.value) FUNC? EXTERN ((EVAR)) ((EVAR)))>,
      (EXTERN <Pragma e.pos> <Make-Name e.value>) <Parse-Extern-Names>;
  };

Parse-Func-Decl // s.type = e.items
  s.type =
    <Expect-Token WORD QWORD> :: (e.pos) (s.WORD-or-QWORD e.name),
      e.pos :
        {
          s S s s = LOCAL (<Module-Name>);
          s.idx e = {
            <RFP-Module-Name <Lookup &RFP-Sources s.idx>> :: e.module,
              <"/=" (e.module) (<Module-Name>)>, IMPORT (e.module);
            EXPORT (<Module-Name>);
          };
        } :: s.linkage (e.module),
          e.module '.' e.name :: e.name,
      <Parse-Format> :: e.in,
      <Expect-Token EQUAL> : e,
      <Parse-Format> :: e.out,
      <Expect-Token SEMICOLON> : e,
      <Bind-Name
        (<Canonical-Name s.WORD-or-QWORD e.name>)
        ((e.pos) (e.name) s.type s.linkage (e.in) (e.out))>,
      {
        \{
          s.linkage : IMPORT;
          <Interface?>;
        } = (s.linkage s.type <Pragma e.pos> <Make-Name e.name> (e.in) (e.out));
        ;
      };

Parse-Format // [] = e.format
  = <Parse-Format-Terms> :: e.terms,
    <Expect-Token EVAR VVAR EMPTY> :: (e.pos) (s.type e.value),
    {
      s.type : EMPTY = ;
      (s.type);
    } :: e.var,
    e.terms e.var <Parse-Format-Terms>;

Parse-Format-Terms // [] = e.terms
  = <Expect-Token LPAREN SYMBOLS NUMBER WORD QWORD SVAR TVAR EMPTY REF>
    :: (e.pos) (s.type e.value),
    {
      s.type : EMPTY = ;
      s.type : {
        LPAREN = (PAREN <Parse-Format>) :: e.hexpr,
          <Expect-Token RPAREN> : e, e.hexpr;
        SYMBOLS = e.value;
        NUMBER = e.value;
        WORD = <Canonical-Word e.value>;
        QWORD = <To-Word e.value>;
        REF = <Parse-Ref>;
        s = (s.type);
      } :: e.term, e.term <Parse-Format-Terms>;
    };

Parse-Hard-Expr // [] = e.format
  =
//<WriteLN Parse-Hard-Expr>,
    <Parse-Hard-Expr-Terms> :: e.terms,
    <Expect-Token EVAR VVAR EMPTY> :: (e.pos) (s.type e.value),
    {
      s.type : EMPTY = ;
      (s.type <Pragma e.pos> <Make-Name e.value>);
    } :: e.var,
    e.terms e.var <Parse-Hard-Expr-Terms>;

Parse-Hard-Expr-Terms // [] = e.terms
  =
//<WriteLN Parse-Hard-Expr-Terms>,
    <Expect-Token LPAREN SYMBOLS NUMBER WORD QWORD SVAR TVAR EMPTY REF>
    :: (e.pos) (s.type e.value),
    {
      s.type : EMPTY = ;
      s.type : {
        LPAREN = (PAREN <Parse-Hard-Expr>) :: e.hexpr,
          <Expect-Token RPAREN> : e, e.hexpr;
        SYMBOLS = e.value;
        NUMBER = e.value;
        WORD = <Canonical-Word e.value>;
        QWORD = <To-Word e.value>;
        REF = <Parse-Ref>;
        s = (s.type <Pragma e.pos> <Make-Name e.value>);
      } :: e.term, e.term <Parse-Hard-Expr-Terms>;
    };

Parse-Trace-Names =
  <Expect-Token WORD QWORD SEMICOLON> : {
    e (SEMICOLON) = ;
    (e.pos) (s.type e.value) =
      <Canonical-Name s.type e.value> :: e.uniname,
      {
        <Lookup-Name (e.pos) (e.uniname)> :: e.name =
          <Lookup &Names e.name> : {
            (e.pragma-pos) (e.origname) FUNC e = e.origname;
            (e.pragma-pos) (e.origname) FUNC? e = e.origname;
            (e.pragma-pos) (e.origname) TFUNC e = e.origname;
            (e.pragma-pos) (e.origname) s.decl e =
              <RFP-Error (e.pos) ("\'" e.name "\' is not a function,")>,
              <RFP-Error (e.pragma-pos)
                ("  '" e.name "' is declared here as " s.decl)>;
          };
        \{
          e.value : 'Main';
          <In-Table? &RFP-Options CASE-INSENSITIVE>, <To-Upper e.value> : 'MAIN';
        } =
          <Module-Name> '.' e.value ;
        <RFP-Error (e.pos) ("Undefined name \'" e.value "\'" )>;
      } :: e.name,
      {
        e.name : v = (TRACE <Make-Name e.name>) <Parse-Trace-Names>;
        <Parse-Trace-Names>;
      };
  };

Parse-Func-Def // (e.pos) (s.type e.value) = e.items
  (e.pos) (s.type e.value) =
//<WriteLN Parse-Func-Def>,
    <Parse-Alt> :: e.items,
    <Expect-Token SEMICOLON> : e,
    <Canonical-Name s.type e.value> :: e.uniname,
//<WriteLN "<-"Parse-Func-Def>,
    {
      <Lookup-Name (e.pos) (e.uniname)> :: e.name =
//<WriteLN <Domain &Names>>,
        <Lookup &Names e.name> :: e.nameinfo =
//<WriteLN e.nameinfo>,
          {
            <R 0 e.nameinfo> : (Def e.def-pos) =
              <RFP-Error (e.pos) ("Redefenition of function '" e.name "',")>,
              <RFP-Error (e.def-pos) ("  previously defined here")>;;
          },
          e.nameinfo : {
            (e.pragma-pos) (e.origname) FUNC s.linkage t.in t.out e =
              <Bind &Names (e.name)
                ((e.pragma-pos) (e.origname)
                 FUNC s.linkage t.in t.out (Def e.pos))>,
              e.origname FUNC s.linkage t.in t.out <Pragma e.pragma-pos>;
            (e.pragma-pos) (e.origname) FUNC? s.linkage t.in t.out e =
              <Bind &Names (e.name)
                ((e.pragma-pos) (e.origname)
                 FUNC? s.linkage t.in t.out (Def e.pos))>,
              e.origname FUNC? s.linkage t.in t.out <Pragma e.pragma-pos>;
            (e.pragma-pos) (e.origname) TFUNC s.linkage t.in t.out e =
              <Bind &Names (e.name)
                ((e.pragma-pos) (e.origname)
                 TFUNC s.linkage t.in t.out (Def e.pos))>,
              e.origname TFUNC s.linkage t.in t.out <Pragma e.pragma-pos>;
            (e.pragma-pos) (e.origname) s.decl e =
              <RFP-Error (e.pos) ("\'" e.name "\' is not a function,")>,
              <RFP-Error (e.pragma-pos)
                ("  '" e.name "' is declared here as " s.decl)>,
              <Bind &Names (e.name)
                ((e.pragma-pos) (e.origname) FUNC LOCAL () () (Def e.pos))>,
              e.origname FUNC LOCAL () () <Pragma e.pragma-pos>;
          };
      \{
        e.value : 'Main';
        <In-Table? &RFP-Options CASE-INSENSITIVE>, <To-Upper e.value> : 'MAIN';
      } =
        <Bind &Names (<Module-Name> '.' e.uniname)
          ((e.pos) (e.value) FUNC EXPORT () ((EVAR)) (Def e.pos))>,
        <Module-Name> '.' e.value FUNC EXPORT () ((EVAR)) <Pragma e.pos>;
      <RFP-Error (e.pos) ("Undefined name \'" e.value "\'" )>,
        <Bind &Names (e.uniname) ((e.pos) (e.value) FUNC LOCAL () () (Def e.pos))>,
        e.value FUNC LOCAL () () <Pragma e.pos>;
    } :: e.name s.tag s.linkage t.in t.out t.pragma,
    {
      <? &Traceall?> : v =
        (TRACE <Make-Name e.name>);;
    } :: e.trace,
    {
      s.linkage : EXTERN = EXPORT;
      s.linkage;
    } :: s.linkage,
    (s.linkage s.tag t.pragma <Make-Name e.name> t.in t.out
      (BRANCH <Pragma e.pos> e.items)
    )
    e.trace;

Parse-Alt e.colon-pos // = e.items
  =
  <Expect-Token LBRACE TLBRACE EMPTY> :: (e.pos) (s.type e.value),
  {
    s.type : EMPTY = <Parse-Sentence e.colon-pos>;
    (e.pos) /*empty*/ $iter
      {
        e.items (BRANCH <Pragma e.snt-end-pos> <Parse-Alt e.colon-pos>)
        :: e.items,
          <Expect-Token SEMICOLON> :: (e.snt-end-pos) t,
          (e.snt-end-pos) e.items;
      } :: (e.snt-end-pos) e.items,
        <Expect-Token RBRACE EMPTY> : (e) (RBRACE e),
        {
          e.items : = (LEFT <Pragma e.pos>);
          {
            s.type : LBRACE = (BLOCK <Pragma e.pos> e.items);
            (BLOCK? <Pragma e.pos> e.items);
          };
        };
  };

Parse-Sentence e.colon-pos // = e.items
  =
//<WriteLN Parse-Sentence>,
    <Parse-Pattern e.colon-pos> :: e.pattern,
    <Parse-Tail> :: e.tail,
    e.pattern e.tail;

Tail? // [] = []
  = <Expect-Token COMMA NOT STAKE CUT FAIL EQUAL ERROR TRAP EMPTY> ::
    (e.pos) (s.type e.value),
    \{
      s.type : EMPTY = $fail;
      <Unget-Token (e.pos) (s.type e.value)>;
    };

Parse-Tail // [] = e.items
  =
//<WriteLN Parse-Tail>,
    <Expect-Token COMMA NOT STAKE CUT FAIL EQUAL ERROR TRAP EMPTY> ::
      (e.pos) (s.type e.value),
    s.type :
      {
        COMMA = <Parse-Path>;
        NOT = (NOT (BRANCH <Pragma e.pos> <Parse-Source>)) <Parse-Tail>;
        STAKE = (STAKE <Pragma e.pos>) <Parse-Path>;
        CUT = (CUT <Pragma e.pos>) <Parse-Path>;
        FAIL = (FAIL <Pragma e.pos>);
        EQUAL = (CUTALL <Pragma e.pos>) <Parse-Path>;
        ERROR = (ERROR <Pragma e.pos>) <Parse-Path>;
        TRAP = <Parse-Path> :: e.try,
          <Expect-Token WITH> : e,
          (TRY (BRANCH <Pragma e.pos> e.try) <Parse-Alt>);
        EMPTY = (RESULT <Pragma e.pos>);
      };

Parse-Path // [] = e.item
  =
//<WriteLN Parse-Path>,
  {
    <Tail?>, <Parse-Tail>;
    <Parse-Source> :: e.source,
      {
        <Tail?>, <Parse-Tail>;
        <Expect-Token DCOLON ITER COLON EMPTY> :: (e.pos) (s.type e),
          s.type : {
            DCOLON = (FORMAT <Pragma e.pos> <Parse-Hard-Expr>) <Parse-Tail>;
            ITER = <Parse-Source> :: e.body,
              {
                <Tail?> =
                  (ITER
                    (BRANCH <Pragma e.pos> e.body)
                    (FORMAT <Pragma e.pos>)
                    (BRANCH <Pragma e.pos> <Parse-Tail>)
                  );
                <Expect-Token DCOLON> :: (e.dcolon-pos) t,
                  (ITER
                    (BRANCH <Pragma e.pos> e.body)
                    (FORMAT <Pragma e.dcolon-pos> <Parse-Hard-Expr>)
                    (BRANCH <Pragma e.dcolon-pos> <Parse-Tail>)
                  );
              };
            COLON = <Parse-Alt e.pos>;
            EMPTY = ;
          };
      } :: e.items,
      e.source e.items;
  };

Parse-Source // [] = e.item
  =
//  <Expect-Token LBRACE TLBRACE EMPTY> :: (e.pos) (s.type e),
  {
//    s.type :
//      \{
//        LBRACE;
//        TLBRACE;
//      } =
//        (e.pos) /*empty*/ $iter
//          {
//            e.items (BRANCH <Pragma e.snt-end-pos> <Parse-Path>) :: e.items,
//              <Expect-Token SEMICOLON> :: (e.snt-end-pos) t,
//              (e.snt-end-pos) e.items;
//          } :: (e.snt-end-pos) e.items,
//            <Expect-Token RBRACE EMPTY> : (e) (RBRACE e),
//            {
//              s.type : LBRACE = (BLOCK <Pragma e.pos> e.items);
//              (BLOCK? <Pragma e.pos> e.items);
//            };
    <Expect-Token EMPTY> :: (e.pos) e,
      (RESULT <Pragma e.pos> <Parse-Result>);
  } :: e.items,
  e.items <Expect-Token COLON EMPTY> $iter {
    <Expect-Token LBRACE TLBRACE EMPTY> :: (e.p) (s.t e.v),
      <Unget-Token (e.p) (s.t e.v)>,
      s.t : \{ LBRACE; TLBRACE; } =
      e.items <Parse-Alt e.pos> <Expect-Token COLON EMPTY>;
    <Unget-Token (e.pos) (s.type e.value)>,
      e.items (e.pos) (EMPTY);
  } :: e.items (e.pos) (s.type e.value),
  s.type : EMPTY =
  e.items;

Parse-Result // [] = e.items
  =
//<WriteLN Parse-Result>,
  {
    <Parse-Result-Term> : v.term =
      v.term <Parse-Result>;
    ;
  };

Parse-Result-Term // [] = e.items
  =
//<WriteLN Parse-Result-Term>,
    <Expect-Token SYMBOLS NUMBER WORD QWORD REF LPAREN
      EVAR VVAR TVAR SVAR LBRACKET LBRACE TLBRACE EMPTY>
    :: (e.pos) (s.type e.value),
    {
      s.type : EMPTY = ;
      s.type : SYMBOLS = e.value;
      s.type : NUMBER = e.value;
      s.type : REF = <Parse-Ref>;
      s.type : LPAREN =
        <Parse-Result> :: e.items,
        <Expect-Token RPAREN> : e, (PAREN e.items);
      s.type :
        \{
          EVAR;
          VVAR;
          TVAR;
          SVAR;
        } = (s.type <Pragma e.pos> <Make-Name e.value>);
      s.type : WORD = <Canonical-Word e.value>;
      s.type : QWORD = <To-Word e.value>;
      s.type : LBRACKET =
        <Expect-Token WORD QWORD> :: (e.pos) (s.type e.value),
        <Canonical-Name s.type e.value> :: e.uniname,
        {
          <Lookup-Name (e.pos) (e.uniname)> :: e.name =
            <Lookup &Names e.name>
            : (e.decl-pos) (e.origname) s.decl-type e.nameinfo =
              {
                s.decl-type :
                  \{
                    FUNC e;
                    FUNC? e;
                    TFUNC e;
                  } = e.origname;
                <RFP-Error (e.pos) ("\'" e.name "\' is not a function")>,
                  <RFP-Error (e.decl-pos)
                    ("  '" e.name "' is declared here as "
                      s.decl-type)>,
                  e.origname;
              };
          <RFP-Error (e.pos) ("Undefined name \'" e.value "\'" )>,
            e.value;
        } :: e.name,
        (CALL <Pragma e.pos> <Make-Name e.name> <Parse-Result>) :: e.items,
        <Expect-Token RBRACKET> : e, e.items;
      s.type : \{ LBRACE; TLBRACE; } =
        (e.pos) /*empty*/ $iter {
          e.items (BRANCH <Pragma e.snt-end-pos> <Parse-Path>) :: e.items,
            <Expect-Token SEMICOLON> :: (e.snt-end-pos) t,
            (e.snt-end-pos) e.items;
        } :: (e.snt-end-pos) e.items,
        <Expect-Token RBRACE EMPTY> : (e) (RBRACE e),
        {
          s.type : LBRACE = (BLOCK <Pragma e.pos> e.items);
          (BLOCK? <Pragma e.pos> e.items);
        };
    };

Parse-Pattern e.colon-pos // = e.items
  =
  <Expect-Token L R EMPTY> : (e.pos) (s.type e),
  (e.colon-pos) (e.pos) : e (v.p) e,
  {
    s.type : R = (RIGHT <Pragma v.p> <Parse-Pattern-Expr>);
    (LEFT <Pragma v.p> <Parse-Pattern-Expr>);
  };

Parse-Pattern-Expr // [] = e.items
  =
//<WriteLN Parse-Pattern-Expr>,
  {
    <Parse-Pattern-Term> : v.term =
      v.term <Parse-Pattern-Expr>;
    ;
  };

Parse-Pattern-Term // [] = e.items
  =
//<WriteLN Parse-Pattern-Term>,
    <Expect-Token SYMBOLS NUMBER WORD QWORD REF LPAREN EVAR VVAR TVAR SVAR EMPTY>
    :: (e.pos) (s.type e.value),
    {
      s.type : EMPTY = ;
      s.type : SYMBOLS = e.value;
      s.type : NUMBER = e.value;
      s.type : WORD = <Canonical-Word e.value>;
      s.type : QWORD = <To-Word e.value>;
      s.type : REF = <Parse-Ref>;
      s.type : LPAREN =
        <Parse-Pattern-Expr> :: e.items,
        <Expect-Token RPAREN> : e, (PAREN e.items);
      s.type :
        \{
          EVAR;
          VVAR;
          TVAR;
          SVAR;
        } = (s.type <Pragma e.pos> <Make-Name e.value>);
    };

Parse-Ref // [] = e.items
  = <Expect-Token WORD QWORD> :: (e.pos) (s.type e.value),
    <Canonical-Name s.type e.value> :: e.uniname,
    {
      <Lookup-Name (e.pos) (e.uniname)> :: e.name =
        <Lookup &Names e.name> :
          (e.decl-pos) (e.origname) s.decl-type e.nameinfo,
        (REF <Make-Name e.origname>);
      <RFP-Error (e.pos) ("Undefined name \'" e.value"\'" )>,
        (REF <Make-Name e.value>);
    };

Make-Name // e.sname = t.name
  e.sname = (<Make-Name2 <To-Chars e.sname>>);

Make-Name2// e.sname = e.name
{
  e.item '.' e.rest = <To-Word e.item> <Make-Name2 e.rest>;
  e.item = <To-Word e.item>;
};

Canonical-Name s.type e.name, {
  s.type : WORD, <In-Table? &RFP-Options CASE-INSENSITIVE> = <To-Upper e.name>;
  e.name;
};

Canonical-Word e.value, {
  <In-Table? &RFP-Options CASE-INSENSITIVE> = <To-Word <To-Upper e.value>>;
  <To-Word e.value>;
};

Pragma s.idx s s.line s.col =
    (PRAGMA (FILE <RFP-Source-File-Name s.idx>) (LINE s.line s.col));