//
// 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>

$use "rfp_helper" "rfp_src" "rfp_lex" ;
$use Access Arithm Box Convert Compare List Table StdIO ;

$func Token_Descr s.type = e.string ;
$func? Get_Token = (e.pos) (s.type e.value) ;
$func Unget_Token (e.pos) (s.type e.value) = ;
$func Put_Tokens e.token = ;
$func? Expect_Token e.types = (e.pos) (s.type e.value) ;
$func? Get_Expected_Token e.types = (e.pos) (s.type e.value) ;

$func Parse_Body = e.items ;
$func Parse_Const_Decls = e.items ;
$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? IsTail = ;
$func Parse_Path = e.items ;
$func Parse_Source = e.items ;
$func Parse_Tail = e.items ;
$func Parse_Module_Name = ;
$func Parse_Imports s.type = e.imports ;
$func Parse_Pattern e.colon_pos = e.items ;

$func? Parse_PatternAlt e.colon_pos = e.items;
$func Parse_Sentence e.colon_pos = e.items;
$func Parse_PatternSource = e.items;

$func Parse_Const_Expr = e.expr ;
$func? Parse_Const_Term = e.term ;
$func Parse_Format = e.format ;
$func Parse_Format_Terms = e.terms ;
$func Parse_Hard_Expr = e.expr ;
$func Parse_Hard_Expr_Terms = e.terms ;
$func Parse_Result = e.result ;
$func? Parse_Result_Term = e.term ;
$func Parse_Pattern_Expr = e.expr ;
$func? Parse_Pattern_Term = e.term ;
$func? Parse_Ground_Term = e.term ;

$func Bind_Name (e.qname) ((e.pos) e.info) = ;
$func Lookup_Name (e.pos) (s.WORDorQWORD e.origName) = e.qname ;
$func? Make_Decl_Name s.WORDorQWORD e.origName = s.linkage e.qname;
$func Canonical_Word e.value = s.word;
$func Pragma e.pos = (PRAGMA e.PragmaBody);

$func Add_Error (e.pos) (e.msg) = ;
$func Add_Warning (e.pos) (e.msg) = ;
$func Add_Errors (e.moduleName) e.errors = ;

$box Module_Name ;
$box Current_Module ;
$box Token_Stack ;
$table Names ;
$table Upper_Names ;
$table ImplemNames ;
$box IsTraceall ;
$box Errors ;

RFP_Parser_Errors = <Get &Errors>;

Add_Error (e.pos) (e.msg) = <Put &Errors (ERROR ((<Get &Current_Module>) (e.pos)) (e.msg))>;

Add_Warning (e.pos) (e.msg) = <Put &Errors (WARNING ((<Get &Current_Module>) (e.pos)) (e.msg))>;

Add_Errors (e.moduleName) e.errors,
  {
    e.errors : e (s.type (e.pos) (e.msg)) e,
      <Put &Errors (s.type ((e.moduleName) (e.pos)) (e.msg))>,
      $fail;;
  };

// 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 = "'='";
  COMMENT = "comment";
  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";
  MODULE = "$module";
  USE = "$use";
  IMPORT = "$import";
  TRACE = "$trace";
  TRACEALL = "$traceall";
  R = "$r";
  L = "$l";
  s.type = "token " s.type;
};

// This function returns a next token
Get_Token // [] = (e.pos) (s.type e.value)
  = <Get &Token_Stack> : (e.token) e.rest,
  <Store &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.pos) (s.type e.value) =
    <Store &Token_Stack ((e.pos) (s.type e.value)) <Get &Token_Stack>>;

Put_Tokens // e.token = []
  e.tokens =
    <Store &Token_Stack e.tokens <Get &Token_Stack>>;

// TODO : Remove this function and add correct error processing
// 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.type : COMMENT = s.message <Get_Token>;
      \{
        s.message : T;
        s.type : EOF;
      }, <Add_Error (e.pos) ("Unexpected " <Token_Descr s.type>)>, $fail;
      F <Get_Token>;
    } :: s.message (e.pos) (s.type e.value),
      # \{ s.type : COMMENT; },
      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);
        };

// This function scans for a token of one of specified types (no EMPTY)
Get_Expected_Token e.types = // (e.pos) (s.type e.value)
  <Get_Token> :: (e.pos) (s.type e.value),
  {
    e.types : e s.type e = (e.pos) (s.type e.value);
    s.type : COMMENT = <Get_Expected_Token e.types>;
    <Unget_Token (e.pos) (s.type e.value)> =
      e.types : e EMPTY e,
      (e.pos) (EMPTY);
  };

RFP_Parser t.fileId =
  <Store &Token_Stack>,
  <ClearTable &ImplemNames>,
  <Store &Current_Module RF t.fileId>,
  {
    <RFP_Src_GetImplementationReader t.fileId>;
    = <Add_Error ((0 0) (0 0)) ("Can't find module implementation " t.fileId)>, $fail;
  } :: e.reader (e.qname),
  <Store &Module_Name e.qname>,
  {
    <RFP_Src_GetInterfaceReader t.fileId> :: e.reader,
      <RFP_Lexer e.reader> <RFP_Src_Close e.reader>;
    () ();
  } :: (e.interf_tokens) (e.errors),
  <Add_Errors (RFI e.qname) e.errors>,
  <RFP_Lexer e.reader> :: (e.implem_tokens) (e.errors),
  <RFP_Src_Close e.reader>,
  <Add_Errors (RF e.qname) e.errors>,
  {
    <Get &Errors> : e (ERROR e) e = $fail;
    <Put_Tokens (() (BOF RFI e.qname)) e.interf_tokens (() (BOF RF)) e.implem_tokens (() (EOFS))>,
//      $trap
        <Parse_Body> :: e.items,
        {
          <Get &Errors> : e (ERROR e) e = $fail;
          (MODULE (<Get &Module_Name>) e.items);
        }
      ;
//      $with {
      //	e "Unexpected fail" = $fail;
//        e.err = $error e.err;
//      };
  };

RFP_Parse_Tokens (e.qname) e.tokens =
  <Store &Module_Name e.qname>,
  <Store &Token_Stack (() (BOF RF)) e.tokens (() (EOFS))>,
  <Parse_Body>;

// The main parsing routine
Parse_Body =
{
  <Expect_Token
    BOX TABLE VECTOR STRING CHANNEL CONST WORD QWORD FUNC "FUNC?" TFUNC EXTERN MODULE USE IMPORT TRACE TRACEALL EOF EOFS BOF
  > :: (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 : MODULE =
        <Parse_Module_Name>;
      s.type : \{ USE; IMPORT; } =
        <Parse_Imports s.type>;
      s.type : CONST =
        <Parse_Const_Decls>;
      s.type : TRACE =
        <Parse_Trace_Names>;
      s.type : TRACEALL =
        <Store &IsTraceall 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 : BOF =
        {
          e.value : RF e =
            <Store &Current_Module RF <Get &Module_Name>>,
            <ReplaceTable &Names &ImplemNames>;
          <Store &Current_Module e.value>,
            <ClearTable &Names>;
        };
      s.type : EOF =
        {
          <Entries &Names> : e ((e.k) (e.v)) e,
            <Bind &ImplemNames (e.k) (e.v)>,
            $fail;;
        };
      # \{ s.type : EOFS; } ;
    } :: e.items = e.items <Parse_Body>;
  // If there are no tokens and we aren't processing an interface file then
  // check for undefined functions.
  <Get &Current_Module> : RFI e = ;
  <Domain &Names> (/*e.undefs*/) $iter {
    e.domain : e (e.name) e.rest,
      <Lookup &Names e.name> : (e.decl_pos) (e.origname) s.tag s.linkage t.in t.out,
      s.linkage : \{ LOCAL; EXPORT; } =
      <Add_Warning (e.decl_pos) ("No defenition for the function '" e.origname "'")>,
      e.rest
      (e.undefs (UNDEF s.tag <Pragma e.decl_pos> (e.name) t.in t.out));
    /*empty*/ (e.undefs);
  } :: e.domain (e.undefs),
    e.domain : /*empty*/ =
    e.undefs;
};

Parse_Module_Name = 
  <Expect_Token WORD QWORD> :: (e.pos) (s.type e.origname),
  <Make_Name e.origname> :: e.modulename,
  {
    (<Get &Current_Module>) (<Get &Module_Name>) : (RFI e1) (e1) =
      <Store &Current_Module RFI e.modulename>,
      <Store &Module_Name e.modulename>;
    <Get &Current_Module> : RFI e.modulename;
    <Get &Current_Module> : RFI e.modname,
      <Add_Error (e.pos) ("Wrong name "e.origname" for module "<Print_Name e.modname>)>;
  },
  <Expect_Token SEMICOLON> : e;

Parse_Imports s.itype // s.itype = e.imports
  = Continue $iter {
    <Expect_Token WORD QWORD SEMICOLON> :: (e.pos) (s.type e.origname),
      {
        s.type : SEMICOLON = Stop e.tokens;
        s.itype : \{
          USE = <RFP_Src_GetInterfaceReaderForModule <Make_Name e.origname>>;
          IMPORT = <RFP_Src_GetInterfaceReaderForClass <Make_Name e.origname>>;
        } :: e.reader (e.qname),
          <RFP_Lexer e.reader> :: (e.toks) (e.errors),
          <RFP_Src_Close e.reader>,
          <Add_Errors (RFI e.qname) e.errors>,
          Continue e.tokens (() (BOF RFI e.qname)) e.toks;
        <Add_Warning (e.pos) ("Can't find module "e.origname)>,
          Continue e.tokens;
      };
  } :: s.Isstop e.tokens,
  s.Isstop : Stop =
  <Put_Tokens e.tokens (() (BOF <Get &Current_Module>))>;

Parse_Object_Decls s.type =
  <Expect_Token WORD QWORD SEMICOLON> : {
    (e) (SEMICOLON) = ;
    (e.pos) (s.WORD_or_QWORD e.origname) =
      <Make_Decl_Name s.WORD_or_QWORD e.origname> :: s.linkage e.qname,
      <Bind_Name (e.qname) ((e.pos) (e.origname) s.type)>,
      (s.linkage s.type <Pragma e.pos> (e.qname)) <Parse_Object_Decls s.type>;
  };

Parse_Const_Decls
  = <Expect_Token WORD QWORD SEMICOLON COMMA> : {
    (e) (SEMICOLON) = ;
    (e) (COMMA) = <Parse_Const_Decls>;
    (e.pos) (s.WORD_or_QWORD e.origname) =
      <Expect_Token EQUAL> : e,
      <Parse_Const_Expr> :: e.expr,
      <Make_Decl_Name s.WORD_or_QWORD e.origname> :: s.linkage e.qname,
      <Bind_Name (e.qname) ((e.pos) (e.origname) CONST)>,
      (s.linkage CONST <Pragma e.pos> (e.qname) e.expr) <Parse_Const_Decls>;
  };

Parse_Extern_Names =
  <Expect_Token WORD QWORD SEMICOLON> : {
    e (SEMICOLON) = ;
    (e.pos) (s.WORD_or_QWORD e.origname) =
      <Make_Name e.origname> : t.name,
      <Bind_Name (t.name) ((e.pos) (e.origname) "FUNC?" EXTERN ((EVAR)) ((EVAR)))>,
      (EXTERN <Pragma e.pos> (t.name)) <Parse_Extern_Names>;
  };

Parse_Func_Decl // s.type = e.items
  s.type =
    <Expect_Token WORD QWORD> :: (e.pos) (s.WORD_or_QWORD e.origname),
      <Make_Decl_Name s.WORD_or_QWORD e.origname> :: s.linkage e.qname,
      <Bind_Name (e.qname) ((e.pos) (e.origname) s.type s.linkage () ())>,
      <Parse_Format> :: e.in,
      <Expect_Token EQUAL> : e,
      <Parse_Format> :: e.out,
      <Expect_Token SEMICOLON> : e,
      <Bind &Names (e.qname) ((e.pos) (e.origname) s.type s.linkage (e.in) (e.out))>,
      {
        \{
          s.linkage : IMPORT;
          //<? &Current-Module> : RFI e;
        } = (s.linkage s.type <Pragma e.pos> (e.qname) (e.in) (e.out));
        ;
      };

Parse_Trace_Names =
  <Expect_Token WORD QWORD SEMICOLON> : {
    e (SEMICOLON) = ;
    (e.pos) (s.WORD_or_QWORD e.origtracename) =
      <Make_Decl_Name s.WORD_or_QWORD e.origtracename> :: s e.qname,
      {
        <Lookup &Names e.qname> : (e.declPos) (e.origDeclName) s.declType e,
          {
            # s.declType : \{ FUNC; "FUNC?"; TFUNC; },
              <Add_Error (e.pos) ("\'" e.origtracename "\' is not a function")>,
              <Add_Error (e.declPos) ("  '" e.origDeclName "' is declared here as " s.declType)>;;
          };
        <Canonical_Word 'Main'> e.qname : s1 e s1;
        <Add_Error (e.pos) ("Undefined name \'" e.origtracename "\'" )>;
      },
      (TRACE (e.qname)) <Parse_Trace_Names>;
  };

Parse_Func_Def // (e.pos) (s.type e.value) = e.items
  (e.pos) (s.WORD_or_QWORD e.funcorigname) =
//<WriteLN Parse-Func-Def>,
    <Parse_Sentence> :: e.items,
    <Expect_Token SEMICOLON> : e,
    <Make_Decl_Name s.WORD_or_QWORD e.funcorigname> :: s e.qname,
    {
      <Lookup &Names e.qname> :: e.nameinfo =
        {
          e.nameinfo : (e) (e.origname) e (Def e.def_pos) =
            <Add_Error (e.pos) ("Redefenition of function '" e.origname "',")>,
            <Add_Error (e.def_pos) ("  previously defined here")>;;
        },
        e.nameinfo : (e.pragma_pos) (e.origname) s.declType s.linkage t.in t.out e =
        {
          s.declType : \{ FUNC; "FUNC?"; TFUNC; },
            <Bind &Names (e.qname)
              ((e.pragma_pos) (e.origname) s.declType s.linkage t.in t.out (Def e.pos))>,
            e.qname s.declType s.linkage t.in t.out <Pragma e.pragma_pos>;
          <Add_Error (e.pos) ("\'" e.origname "\' is not a function,")>,
            <Add_Error (e.pragma_pos) ("  '" e.origname "' is declared here as " s.declType)>,
            e.qname FUNC LOCAL () () <Pragma e.pragma_pos>;
        };
      <Canonical_Word 'Main'> e.qname : s1 e s1,
        <Bind &Names (e.qname) ((e.pos) (e.funcorigname) FUNC EXPORT () ((EVAR)) (Def e.pos))>,
        e.qname FUNC EXPORT () ((EVAR)) <Pragma e.pos>;
      <Add_Error (e.pos) ("Undefined name \'" e.funcorigname "\'" )>,
        <Bind &Names (e.qname) ((e.pos) (e.funcorigname) FUNC LOCAL ((EVAR)) ((EVAR)) (Def e.pos))>,
        e.qname FUNC LOCAL ((EVAR)) ((EVAR)) <Pragma e.pos>;
    } :: e.qname s.tag s.linkage t.in t.out t.pragma,
    {
      <Get &IsTraceall> : v =
        (TRACE (e.qname));;
    } :: e.trace,
    {
      s.linkage : EXTERN = EXPORT;
      s.linkage;
    } :: s.linkage,
    (s.linkage s.tag t.pragma (e.qname) t.in t.out
      (BRANCH <Pragma e.pos> e.items)
    )
    e.trace;

IsTail // [] = []
  = <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_Sentence>);
        EMPTY = (RESULT <Pragma e.pos>);
      };

Parse_Path // [] = e.item
  =
//<WriteLN Parse-Path>,
  {
    <IsTail>, <Parse_Tail>;
    <Parse_Source> :: e.source,
      {
        <IsTail>, <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,
              {
                <IsTail> =
                  (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_Pattern e.pos> <Parse_Tail>;
            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>) <Parse_PatternSource>;
//  };

Parse_Sentence e.colon_pos = {
  <Parse_PatternAlt e.colon_pos> <Parse_PatternSource> :: e.source = {
    <IsTail>, <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,
          {
            <IsTail> =
              (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_Pattern e.pos> <Parse_Tail>;
        EMPTY = ;
      };
  } :: e.items,
    e.source e.items;
  <Parse_Pattern e.colon_pos> <Parse_Tail>;
};

Parse_PatternSource =
  {
    <Get_Expected_Token COLON> :: (e.p) (s.t e.v),
      {
        <Parse_PatternAlt e.p> <Parse_PatternSource>;
        <Unget_Token (e.p) (s.t e.v)>;
      };;
  };

Parse_PatternAlt e.colon_pos // = e.items
  =
  <Get_Expected_Token LBRACE TLBRACE> :: (e.pos) (s.type e.value),
  {
    (e.pos) /*empty*/ $iter
      {
        e.items (BRANCH <Pragma e.snt_end_pos> <Parse_Sentence 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,
      <Get_Expected_Token RBRACE> : e,
      {
        s.type : LBRACE = (BLOCK <Pragma e.pos> e.items);
        ("BLOCK?" <Pragma e.pos> e.items);
      };
  };

Parse_Pattern e.colon_pos = // e.pattern
  <Get_Expected_Token L R EMPTY> :: (e.pos) (s.type e),
  (e.colon_pos) (e.pos) : e (v.p) e,
  {
    s.type : R = RIGHT;
    LEFT;
  } :: s.type,
  (s.type <Pragma v.p> <Parse_Pattern_Expr>);



Parse_Const_Expr = // e.expr
  {
    <Parse_Const_Term> <Parse_Const_Expr>;;
  };

Parse_Const_Term = // e.term
  \{
    <Parse_Ground_Term>;
    <Get_Expected_Token LPAREN> :: (e.pos) (s.type e.value),
      <Parse_Const_Expr> :: e.expr,
      <Expect_Token RPAREN> : e,
      (PAREN e.expr);
  };

Parse_Format = // e.format
  <Parse_Format_Terms> :: e.terms1,
  {
    <Get_Expected_Token EVAR VVAR> :: (e.pos) (s.type e.value),
      (s.type) <Parse_Format_Terms>;;
  } :: e.terms2,
  e.terms1 e.terms2;

Parse_Format_Terms = // e.terms
  {
    \{
      <Parse_Ground_Term>;
      <Get_Expected_Token LPAREN SVAR TVAR> :: (e.pos) (s.type e.value),
        {
          s.type : LPAREN =
            <Parse_Format> :: e.format,
            <Expect_Token RPAREN> : e,
            (PAREN e.format);
          (s.type);
        };
    } :: e.term, e.term <Parse_Format_Terms>;;
  };

Parse_Hard_Expr = // e.expr
  <Parse_Hard_Expr_Terms> :: e.terms1,
  {
    <Get_Expected_Token EVAR VVAR> :: (e.pos) (s.type e.value),
      (s.type <Pragma e.pos> (e.value)) <Parse_Hard_Expr_Terms>;;
  } :: e.terms2,
  e.terms1 e.terms2;

Parse_Hard_Expr_Terms = // e.terms
  {
    \{
      <Parse_Ground_Term>;
      <Get_Expected_Token LPAREN SVAR TVAR> :: (e.pos) (s.type e.value),
        {
          s.type : LPAREN =
            <Parse_Hard_Expr> :: e.expr,
            <Expect_Token RPAREN> : e,
            (PAREN e.expr);
          (s.type <Pragma e.pos> (e.value));
        };
    } :: e.term, e.term <Parse_Hard_Expr_Terms>;;
  };

Parse_Result = // e.result
  {
    <Parse_Result_Term> <Parse_Result>;;
  };

Parse_Result_Term = // e.term
  \{
    <Parse_Ground_Term>;
    <Get_Expected_Token EVAR SVAR TVAR VVAR LPAREN LBRACKET LBRACE TLBRACE> :: (e.pos) (s.type e.value),
    {
      s.type : \{ EVAR; SVAR; TVAR; VVAR; } =
        (s.type <Pragma e.pos> (e.value));
      s.type : LPAREN =
        <Parse_Result> :: e.result,
        <Expect_Token RPAREN> : e,
        (PAREN e.result);
      s.type : LBRACKET =
        {
          <Get_Expected_Token WORD QWORD> :: (e.pos) (s.WORDorQWORD e.origCallName),
          <Lookup_Name (e.pos) (s.WORDorQWORD e.origCallName)> :: e.qname,
          {
            <Lookup &Names e.qname> : (e.declPos) (e.origDeclName) s.declType e,
              # s.declType : \{ FUNC; "FUNC?"; TFUNC; },
              <Add_Error (e.pos) ("\'" e.origCallName "\' is not a function")>,
              <Add_Error (e.declPos) ("  '" e.origDeclName "' is declared here as " s.declType)>;;
          }, e.qname;
          <Add_Error (e.pos) (<Token_Descr LBRACKET>" should be followed by an identifier")>;
        } :: e.qname,
        (CALL <Pragma e.pos> (e.qname) <Parse_Result>) :: e.term,
        <Expect_Token RBRACKET> : e,
        e.term;
      s.type : \{ LBRACE; TLBRACE; } =
        (e.pos) /*empty*/ $iter {
          e.items (BRANCH <Pragma e.sntEndPos> <Parse_Path>) :: e.items,
            <Expect_Token SEMICOLON> :: (e.sntEndPos) t,
            (e.sntEndPos) e.items;
        } :: (e.sntEndPos) e.items,
        <Get_Expected_Token RBRACE> : e, // TODO: is it good for error correction?
        {
          s.type : LBRACE = (BLOCK <Pragma e.pos> e.items);
          ("BLOCK?" <Pragma e.pos> e.items);
        };
    };
  };

Parse_Pattern_Expr = // e.expr
  {
    <Parse_Pattern_Term> <Parse_Pattern_Expr>;;
  };

Parse_Pattern_Term = // e.term
  \{
    <Parse_Ground_Term>;
    <Get_Expected_Token EVAR SVAR TVAR VVAR LPAREN> :: (e.pos) (s.type e.value),
    {
      s.type : \{ EVAR; SVAR; TVAR; VVAR; } =
        (s.type <Pragma e.pos> (e.value));
      s.type : LPAREN =
        <Parse_Pattern_Expr> :: e.expr,
        <Expect_Token RPAREN> : e,
        (PAREN e.expr);
    };
  };

Parse_Ground_Term = // e.term
  <Get_Expected_Token NUMBER SYMBOLS WORD QWORD REF> :: (e.pos) (s.type e.value),
  s.type : {
      NUMBER = e.value;
      SYMBOLS = e.value;
      WORD = <Canonical_Word e.value>;
      QWORD = <ToWord e.value>;
      REF =
      {
        (REF (<Lookup_Name <Get_Expected_Token WORD QWORD>>));
        <Add_Error (e.pos) (<Token_Descr REF>" should be followed by an identifier")>;
      };
  };



Bind_Name (e.qname) ((e.pos) e.info) =
  {
    <Lookup &Names e.qname> : (e.prevPos) e = 
      e.info : (e.origName) e,
      <Add_Error (e.pos) ("Redeclaration of '" e.origName "',")>,
      <Add_Error (e.prevPos) ("  previously declared here")>;;
  },
  <Bind &Names (e.qname) ((e.pos) e.info)>;

Lookup_Name (e.pos) (s.WORDorQWORD e.origName) =
  <Make_Name e.origName> :: e.name,
  {
    \{
      s.WORDorQWORD : WORD, <IsInTable &RFP_Options "CASE-INSENSITIVE"> =
        e.name : e.m s.n,
        e.m <ToWord <ToUpper <ToChars s.n>>> :: e.name,
        <Domain &Upper_Names> : e (e.module e.name) e.rest =
        (<Lookup &Upper_Names e.module e.name>) (e.name) e.rest;
      <Domain &Names> : e (e.module e.name) e.rest =
        (e.module e.name) (e.name) e.rest;
    } :: (e.qname) (e.name) e.rest =
      {
        e.rest : e (e.module2 e.name) e,
          <Add_Error (e.pos)
            ("Ambiguous name \'" e.origName "\' - both \'"
              <Print_Name e.qname> "\' and \'"
              <Print_Name e.module2 e.name> "\' do exist")>,
          $fail;;
      },
      e.qname;
    <Add_Error (e.pos) ("Undefined name \'" e.origName "\'" )>,
      e.name;
  };

Make_Decl_Name s.WORDorQWORD e.origName =
  <Make_Name e.origName> :: e.name,
  {
    e.name : t = <Get &Current_Module> : {
      RF e.moduleName = LOCAL e.moduleName;
      RFI e.moduleName = {
        <Get &Module_Name> : e.moduleName = EXPORT e.moduleName;
        IMPORT e.moduleName;
      };
    } :: s.linkage e.moduleName,
      {
        s.WORDorQWORD : WORD, <IsInTable &RFP_Options "CASE-INSENSITIVE"> =
          <Bind &Upper_Names
            (e.moduleName <ToWord <ToUpper <ToChars e.name>>>) (e.moduleName e.name)>;;
      },
      s.linkage e.moduleName e.name;
    = $fail;
  };    

Canonical_Word e.value, {
  <IsInTable &RFP_Options "CASE-INSENSITIVE"> = <ToWord <ToUpper e.value>>;
  <ToWord e.value>;
};

Pragma (e.pos) e =
  (PRAGMA (FILE <Get &Current_Module>) (LINE e.pos));