source: to-imperative/trunk/compiler/rfp_parse.rf @ 1950

Last change on this file since 1950 was 1950, checked in by orlov, 15 years ago
  • A lot of changes for the compilation to Java. Self-translates to compilable Java-code!
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 24.8 KB
Line 
1//
2// Copyright (C) 1999, 2000 Refal+ Development Group
3//
4// Refal+ is free software; you can redistribute it and/or modify
5// it under the terms of the GNU General Public License as published by
6// the Free Software Foundation; either version 2 of the License, or
7// (at your option) any later version.
8//
9// Refal+ is distributed in the hope that it will be useful,
10// but WITHOUT ANY WARRANTY; without even the implied warranty of
11// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12// GNU General Public License for more details.
13//
14// You should have received a copy of the GNU General Public License
15// along with Refal+; if not, write to the Free Software
16// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
17//
18// $Source$
19// $Revision: 1950 $
20// $Date: 2006-05-07 01:17:28 +0000 (Sun, 07 May 2006) $
21// Author: Andrey Slepuhin <pooh@msu.ru>
22
23// rfp_parse.rfi
24$use "rfpc" ; // rfpc.rfi
25$use "rfp_helper" ; // rfp_helper.rfi
26$use "rfp_src" ; // rfp_src.rfi
27$use "rfp_err" ; // rfp_err.rfi
28
29$use Box ;
30$use Convert ;
31$use Compare ;
32$use Table ;
33$use StdIO ;
34$use Arithm ;
35$use Access ;
36
37$func Parse-Body = e.items ;
38$func Parse-Const-Decls = e.items ;
39// $func Parse-Const-Decl e.name = e.items ;
40$func Parse-Const-Expr = e.expr ;
41$func Parse-Const-Term (e.pos) (s.type e.value) = e.term ;
42$func Module-Name = e.name ;
43$func Parse-Object-Decls s.type  = e.items ;
44$func Parse-Extern-Names = e.extern-decls;
45$func Parse-Func-Decl s.type = e.items ;
46$func Parse-Trace-Names = e.trace-directives ;
47$func Parse-Func-Def (e.pos) (s.type e.value) = e.items ;
48// $func Full-Name s.idx (e.name) = e.fullname ;
49$func? Lookup-Name (e.pos) (e.name) = e.fullname ;
50$func Lookup-Check (e.pos) (e.name) (e.fullname) (e.rest) = ;
51$func Bind-Name (e.name) ((e.pos) e.info) = ;
52$func? Get-Token = (e.pos) (s.type e.value) ;
53$func Unget-Token e.token = ;
54$func? Expect-Token e.types = (e.pos) (s.type e.value) ;
55$func Token-Descr s.type = e.string ;
56$func Parse-Format = e.format ;
57$func Parse-Format-Terms = e.terms ;
58$func Parse-Result = e.format ;
59$func Parse-Result-Term = e.terms ;
60$func Parse-Hard-Expr = e.format ;
61$func Parse-Hard-Expr-Terms = e.terms ;
62$func Parse-Sentence e.colon-pos = e.items ;
63$func Parse-Pattern e.colon-pos = e.items ;
64$func Parse-Pattern-Expr = e.items ;
65$func Parse-Pattern-Term = e.items ;
66$func Parse-Ref = e.items ;
67$func? Tail? = ;
68$func Parse-Path = e.items ;
69$func Parse-Source = e.items ;
70$func Parse-Tail = e.items ;
71$func Parse-Alt e.colon-pos = e.items ;
72$func Make-Name2 e.sname = e.name ;
73$func Parse-Imports = e.imports ;
74$func? Interface? = ;
75$func Canonical-Name s.type e.name = e.name;
76$func Canonical-Word e.value = s.word;
77$func Pragma e.pos = (PRAGMA e.PragmaBody);
78
79$box Module-Name-Box ;
80$box Saved-Position ;
81$box Unget-Stack ;
82$table Constants ;
83$table Names ;
84
85$box Traceall? ;
86
87// This function returns a token description according
88// to its type
89Token-Descr // s.type = e.string
90{
91  COMMA = "\',\'";
92  COLON = "\':\'";
93  DCOLON = "\'::\'";
94  SEMICOLON = "\';\'";
95  LBRACE = "'{'";
96  RBRACE = "'}'";
97  LBRACKET = "'<'";
98  RBRACKET = "'>'";
99  LPAREN = "'('";
100  RPAREN = "')'";
101  REF = "'&'";
102  NOT = "'#'";
103  EOF = "end of file";
104  EVAR = "e-variable";
105  VVAR = "v-variable";
106  TVAR = "t-variable";
107  SVAR = "s-variable";
108  BOX = "$box";
109  TABLE = "$table";
110  VECTOR = "$vector";
111  STRING = "$string";
112  FUNC = "$func";
113  FUNC? = "$func?";
114  TFUNC = "$tfunc";
115  EXTERN = "$extern";
116  CHANNEL = "$channel";
117  USE = "$use";
118  TRACE = "$trace";
119  TRACEALL = "$traceall";
120  s.type = "token " s.type;
121};
122
123// This function returns a next token
124Get-Token // [] = (e.pos) (s.type e.value)
125 = {
126   // First check if there are any tokens in unget stack
127   <? &Unget-Stack> : (e.tokens) ((e.pos) (s.type e.value)) =
128     <Store &Unget-Stack e.tokens>, (e.pos) (s.type e.value);
129   // If unget stack is empty, get a token in a usual way
130   <? &RFP-Token-Stack> : (e.token) e.rest,
131     <Store &RFP-Token-Stack e.rest> = e.token : (e.pos) (s.type e.value),
132     (e.pos) (s.type e.value);
133 };
134
135// This function puts a token to unget stack for future use
136Unget-Token // e.token = []
137  e.token =
138    <Store &Unget-Stack (<? &Unget-Stack>) (e.token)>;
139
140// This function scans for a token of one of specified types
141Expect-Token // e.types = (e.pos) (s.type e.value)
142  e.types =
143    T <Get-Token> $iter \{
144      \{
145        s.message : T;
146        s.type : EOF;
147      }, <RFP-Error (e.pos) ("Unexpected " <Token-Descr s.type>)>, $fail;
148      F <Get-Token>;
149    } :: s.message (e.pos) (s.type e.value),
150      e.types :
151        \{
152           e s.type e =
153//<WriteLN "Expect: got " s.type e.value>,
154             (e.pos) (s.type e.value);
155           e EMPTY e =
156//<WriteLN "Expect: got " EMPTY>,
157             <Unget-Token (e.pos) (s.type e.value)>, (e.pos) (EMPTY);
158        };
159
160RFP-Parser =
161  <RFP-Clear-Table &Constants>,
162  <RFP-Clear-Table &Names>,
163  <Store &Unget-Stack>,
164  <Store &Module-Name-Box <RFP-Module-Name <Lookup &RFP-Sources 1>>>,
165//  $trap
166    {
167      <Interface?>,
168        (INTERFACE <Make-Name <Module-Name>> <Parse-Body>);
169      (MODULE <Make-Name <Module-Name>> <Parse-Body>);
170    }
171//  $with {
172//    e = <? &Saved-Position> :: e.pos,
173//      <RFP-Error (e.pos) ("Unexpected end of file during declaration parsing")>,
174//      FAIL;
175//  };
176  ;
177
178// This is a shortcut function to get a module name
179Module-Name = <? &Module-Name-Box>;
180
181Interface?
182  = <RFP-Source-File-Name 1> : e '.rfi';
183
184// The main parsing routine
185Parse-Body =
186{
187  <Expect-Token
188    BOX TABLE VECTOR STRING CHANNEL CONST WORD QWORD FUNC FUNC? TFUNC EXTERN USE TRACE TRACEALL EOF
189  > :: (e.pos) (s.type e.value),
190    <Store &Saved-Position e.pos>,
191    \{
192      // If token type is BOX, TABLE, VECTOR, STRING or CHANNEL
193      // then parse object declaration
194      s.type :
195        \{
196          BOX;
197          TABLE;
198          VECTOR;
199          STRING;
200          CHANNEL;
201        } = <Parse-Object-Decls s.type>;
202      s.type : USE =
203        <Parse-Imports>;
204      // If token type is CONST then parse constant declaration
205      s.type : CONST =
206        <Parse-Const-Decls>;
207      s.type : TRACE =
208        <Parse-Trace-Names>;
209      s.type : TRACEALL =
210        <Store &Traceall? TRACEALL>,
211        <Expect-Token SEMICOLON EMPTY> : e;
212      s.type : EXTERN =
213        <Parse-Extern-Names>;
214      s.type :
215        \{
216          FUNC;
217          FUNC?;
218          TFUNC;
219        } = <Parse-Func-Decl s.type>;
220      s.type :
221        \{
222          WORD;
223          QWORD;
224        } = <Parse-Func-Def (e.pos) (s.type e.value)>;
225      # \{ s.type : EOF; } ;
226    } :: e.items = e.items <Parse-Body>;
227  // If there are no tokens and we aren't processing an interface file then
228  // check for undefined functions.
229  # <Interface?>,
230    <Domain &Names> (/*e.undefs*/) $iter {
231      e.domain : e (e.name) e.rest,
232        <Lookup &Names e.name> : (e.decl-pos) (e.decl-name) s.tag s.linkage t.in t.out,
233        s.linkage : \{ LOCAL; EXPORT; } =
234        <RFP-Warning (e.decl-pos) ("No defenition for the function '" e.name "'")>,
235        e.rest
236        (e.undefs (UNDEF s.tag <Pragma e.decl-pos> <Make-Name e.decl-name> t.in t.out));
237      /*empty*/ (e.undefs);
238    } :: e.domain (e.undefs),
239    e.domain : /*empty*/ =
240    e.undefs;
241};
242
243Parse-Imports // [] = e.imports
244  = <Expect-Token WORD QWORD SEMICOLON>
245    :: (e.pos) (s.type e.value),
246    {
247      s.type : SEMICOLON;
248      (USE <Make-Name e.value>) <Parse-Imports>;
249    };
250
251Parse-Object-Decls s.type =
252{
253  <Expect-Token WORD QWORD SEMICOLON> :
254    {
255      (e) (SEMICOLON) = ;
256      (e.pos) (s.WORD-or-QWORD e.name) = e.pos :
257        {
258          s S s s = LOCAL (<Module-Name>);
259          s.idx e = {
260            <RFP-Module-Name <Lookup &RFP-Sources s.idx>>
261              :: e.module,
262              <"/=" (e.module) (<Module-Name>)>, IMPORT (e.module);
263            EXPORT (<Module-Name>);
264          };
265        } :: s.linkage (e.module),
266        e.module '.' e.name :: e.name,
267        <Bind-Name
268          (<Canonical-Name s.WORD-or-QWORD e.name>)
269          ((e.pos) (e.name) s.type)>,
270        (s.linkage s.type <Pragma e.pos> <Make-Name e.name>)
271        <Parse-Object-Decls s.type>;
272    };
273};
274
275Parse-Const-Expr
276  = <Expect-Token REF SYMBOLS NUMBER WORD QWORD LPAREN EMPTY>
277    :: (e.pos) (s.type e.value),
278    {
279      s.type : EMPTY = ;
280      <Parse-Const-Term (e.pos) (s.type e.value)> <Parse-Const-Expr>;
281    };
282
283Parse-Const-Term (e.pos) (s.type e.value) =
284  s.type :
285  {
286    REF = <Parse-Ref>;
287    SYMBOLS = e.value;
288    NUMBER = e.value;
289    WORD = <Canonical-Word e.value>;
290    QWORD = <To-Word e.value>;
291    LPAREN = <Parse-Const-Expr> :: e.expr,
292      <Expect-Token RPAREN> : e, (PAREN e.expr);
293  };
294
295Parse-Const-Decls
296  = <Expect-Token WORD QWORD SEMICOLON COMMA> :: (e.pos) (s.type e.value),
297    s.type :
298      {
299        SEMICOLON = ;
300        COMMA = <Parse-Const-Decls> ;
301        s.WORD-or-QWORD =
302          <Expect-Token EQUAL> : e,
303            <Parse-Const-Expr> :: e.expr,
304            e.pos :
305              {
306                s S s s = LOCAL (<Module-Name>);
307                s.idx e = {
308                  <RFP-Module-Name <Lookup &RFP-Sources s.idx>>
309                  :: e.module,
310                    <"/=" (e.module) (<Module-Name>)>, IMPORT (e.module);
311                  EXPORT (<Module-Name>);
312                };
313              } :: s.linkage (e.module),
314              e.module '.' e.value :: e.name,
315              <Bind-Name
316                (<Canonical-Name s.WORD-or-QWORD e.name>)
317                ((e.pos) (e.name) CONST)>,
318              (s.linkage CONST <Pragma e.pos> <Make-Name e.name> e.expr)
319              <Parse-Const-Decls>;
320//            <Parse-Const-Decl <Full-Name s.idx (e.value)>>;
321      };
322
323/*
324Parse-Const-Decl e.name =
325  <Expect-Token EQUAL> : e,
326  <Parse-Const-Expr> :: e.expr,
327  <Bind &Names (e.name) (CONST e.expr)>,
328  (CONST <Make-Name e.name> e.expr) <Parse-Const-Decls>;
329
330Full-Name s.idx (e.name) =
331  <RFP-Module-Name <Lookup &RFP-Sources s.idx>> '.' e.name;
332*/
333
334Lookup-Name (e.pos) (e.name) =
335  <Domain &Names> :
336    \{
337      e (e.name) e.rest = (e.name) (e.rest);
338      e (e.module '.' e.name) e.rest =
339        (e.module '.' e.name) (e.rest);
340    } :: (e.fullname) (e.rest),
341    <Lookup-Check (e.pos) (e.name) (e.fullname) (e.rest)>,
342    e.fullname;
343
344Lookup-Check (e.pos) (e.name) (e.fullname) (e.names) =
345  {
346    e.names :
347      \{
348        e (e.name) e.rest = (e.name) (e.rest);
349        e (e.module '.' e.name) e.rest = (e.module '.' e.name) (e.rest);
350      } :: (e.other) (e.rest),
351      <RFP-Error (e.pos)
352        ("Ambiguous name \'" e.name "\' - both \'"
353         e.fullname "\' and \'"
354         e.other "\' do exist")>,
355      <Lookup-Check (e.pos) (e.name) (e.fullname) (e.rest)>;;
356  };
357
358Bind-Name (e.name) ((e.pos) e.info) =
359  {
360    <Lookup &Names e.name> : (e.prev-pos) e =
361      <RFP-Error (e.pos) ("Redeclaration of '" e.name "',")>,
362      <RFP-Error (e.prev-pos) ("  previously declared here")>;;
363  },
364  <Bind &Names (e.name) ((e.pos) e.info)>;
365
366Parse-Extern-Names =
367  <Expect-Token WORD QWORD SEMICOLON> : {
368    e (SEMICOLON) = ;
369    (e.pos) (s.type e.value) =
370      <Bind-Name
371        (<Canonical-Name s.type e.value>)
372        ((e.pos) (e.value) FUNC? EXTERN ((EVAR)) ((EVAR)))>,
373      (EXTERN <Pragma e.pos> <Make-Name e.value>) <Parse-Extern-Names>;
374  };
375
376Parse-Func-Decl // s.type = e.items
377  s.type =
378    <Expect-Token WORD QWORD> :: (e.pos) (s.WORD-or-QWORD e.name),
379      e.pos :
380        {
381          s S s s = LOCAL (<Module-Name>);
382          s.idx e = {
383            <RFP-Module-Name <Lookup &RFP-Sources s.idx>> :: e.module,
384              <"/=" (e.module) (<Module-Name>)>, IMPORT (e.module);
385            EXPORT (<Module-Name>);
386          };
387        } :: s.linkage (e.module),
388          e.module '.' e.name :: e.name,
389      <Parse-Format> :: e.in,
390      <Expect-Token EQUAL> : e,
391      <Parse-Format> :: e.out,
392      <Expect-Token SEMICOLON> : e,
393      <Bind-Name
394        (<Canonical-Name s.WORD-or-QWORD e.name>)
395        ((e.pos) (e.name) s.type s.linkage (e.in) (e.out))>,
396      {
397        \{
398          s.linkage : IMPORT;
399          <Interface?>;
400        } = (s.linkage s.type <Pragma e.pos> <Make-Name e.name> (e.in) (e.out));
401        ;
402      };
403
404Parse-Format // [] = e.format
405  = <Parse-Format-Terms> :: e.terms,
406    <Expect-Token EVAR VVAR EMPTY> :: (e.pos) (s.type e.value),
407    {
408      s.type : EMPTY = ;
409      (s.type);
410    } :: e.var,
411    e.terms e.var <Parse-Format-Terms>;
412
413Parse-Format-Terms // [] = e.terms
414  = <Expect-Token LPAREN SYMBOLS NUMBER WORD QWORD SVAR TVAR EMPTY REF>
415    :: (e.pos) (s.type e.value),
416    {
417      s.type : EMPTY = ;
418      s.type : {
419        LPAREN = (PAREN <Parse-Format>) :: e.hexpr,
420          <Expect-Token RPAREN> : e, e.hexpr;
421        SYMBOLS = e.value;
422        NUMBER = e.value;
423        WORD = <Canonical-Word e.value>;
424        QWORD = <To-Word e.value>;
425        REF = <Parse-Ref>;
426        s = (s.type);
427      } :: e.term, e.term <Parse-Format-Terms>;
428    };
429
430Parse-Hard-Expr // [] = e.format
431  =
432//<WriteLN Parse-Hard-Expr>,
433    <Parse-Hard-Expr-Terms> :: e.terms,
434    <Expect-Token EVAR VVAR EMPTY> :: (e.pos) (s.type e.value),
435    {
436      s.type : EMPTY = ;
437      (s.type <Pragma e.pos> <Make-Name e.value>);
438    } :: e.var,
439    e.terms e.var <Parse-Hard-Expr-Terms>;
440
441Parse-Hard-Expr-Terms // [] = e.terms
442  =
443//<WriteLN Parse-Hard-Expr-Terms>,
444    <Expect-Token LPAREN SYMBOLS NUMBER WORD QWORD SVAR TVAR EMPTY REF>
445    :: (e.pos) (s.type e.value),
446    {
447      s.type : EMPTY = ;
448      s.type : {
449        LPAREN = (PAREN <Parse-Hard-Expr>) :: e.hexpr,
450          <Expect-Token RPAREN> : e, e.hexpr;
451        SYMBOLS = e.value;
452        NUMBER = e.value;
453        WORD = <Canonical-Word e.value>;
454        QWORD = <To-Word e.value>;
455        REF = <Parse-Ref>;
456        s = (s.type <Pragma e.pos> <Make-Name e.value>);
457      } :: e.term, e.term <Parse-Hard-Expr-Terms>;
458    };
459
460Parse-Trace-Names =
461  <Expect-Token WORD QWORD SEMICOLON> : {
462    e (SEMICOLON) = ;
463    (e.pos) (s.type e.value) =
464      <Canonical-Name s.type e.value> :: e.uniname,
465      {
466        <Lookup-Name (e.pos) (e.uniname)> :: e.name =
467          <Lookup &Names e.name> : {
468            (e.pragma-pos) (e.origname) FUNC e = e.origname;
469            (e.pragma-pos) (e.origname) FUNC? e = e.origname;
470            (e.pragma-pos) (e.origname) TFUNC e = e.origname;
471            (e.pragma-pos) (e.origname) s.decl e =
472              <RFP-Error (e.pos) ("\'" e.name "\' is not a function,")>,
473              <RFP-Error (e.pragma-pos)
474                ("  '" e.name "' is declared here as " s.decl)>;
475          };
476        \{
477          e.value : 'Main';
478          <In-Table? &RFP-Options CASE-INSENSITIVE>, <To-Upper e.value> : 'MAIN';
479        } =
480          <Module-Name> '.' e.value ;
481        <RFP-Error (e.pos) ("Undefined name \'" e.value "\'" )>;
482      } :: e.name,
483      {
484        e.name : v = (TRACE <Make-Name e.name>) <Parse-Trace-Names>;
485        <Parse-Trace-Names>;
486      };
487  };
488
489Parse-Func-Def // (e.pos) (s.type e.value) = e.items
490  (e.pos) (s.type e.value) =
491//<WriteLN Parse-Func-Def>,
492    <Parse-Alt> :: e.items,
493    <Expect-Token SEMICOLON> : e,
494    <Canonical-Name s.type e.value> :: e.uniname,
495//<WriteLN "<-"Parse-Func-Def>,
496    {
497      <Lookup-Name (e.pos) (e.uniname)> :: e.name =
498//<WriteLN <Domain &Names>>,
499        <Lookup &Names e.name> :: e.nameinfo =
500//<WriteLN e.nameinfo>,
501          {
502            <R 0 e.nameinfo> : (Def e.def-pos) =
503              <RFP-Error (e.pos) ("Redefenition of function '" e.name "',")>,
504              <RFP-Error (e.def-pos) ("  previously defined here")>;;
505          },
506          e.nameinfo : {
507            (e.pragma-pos) (e.origname) FUNC s.linkage t.in t.out e =
508              <Bind &Names (e.name)
509                ((e.pragma-pos) (e.origname)
510                 FUNC s.linkage t.in t.out (Def e.pos))>,
511              e.origname FUNC s.linkage t.in t.out <Pragma e.pragma-pos>;
512            (e.pragma-pos) (e.origname) FUNC? s.linkage t.in t.out e =
513              <Bind &Names (e.name)
514                ((e.pragma-pos) (e.origname)
515                 FUNC? s.linkage t.in t.out (Def e.pos))>,
516              e.origname FUNC? s.linkage t.in t.out <Pragma e.pragma-pos>;
517            (e.pragma-pos) (e.origname) TFUNC s.linkage t.in t.out e =
518              <Bind &Names (e.name)
519                ((e.pragma-pos) (e.origname)
520                 TFUNC s.linkage t.in t.out (Def e.pos))>,
521              e.origname TFUNC s.linkage t.in t.out <Pragma e.pragma-pos>;
522            (e.pragma-pos) (e.origname) s.decl e =
523              <RFP-Error (e.pos) ("\'" e.name "\' is not a function,")>,
524              <RFP-Error (e.pragma-pos)
525                ("  '" e.name "' is declared here as " s.decl)>,
526              <Bind &Names (e.name)
527                ((e.pragma-pos) (e.origname) FUNC LOCAL () () (Def e.pos))>,
528              e.origname FUNC LOCAL () () <Pragma e.pragma-pos>;
529          };
530      \{
531        e.value : 'Main';
532        <In-Table? &RFP-Options CASE-INSENSITIVE>, <To-Upper e.value> : 'MAIN';
533      } =
534        <Bind &Names (<Module-Name> '.' e.uniname)
535          ((e.pos) (e.value) FUNC EXPORT () ((EVAR)) (Def e.pos))>,
536        <Module-Name> '.' e.value FUNC EXPORT () ((EVAR)) <Pragma e.pos>;
537      <RFP-Error (e.pos) ("Undefined name \'" e.value "\'" )>,
538        <Bind &Names (e.uniname) ((e.pos) (e.value) FUNC LOCAL () () (Def e.pos))>,
539        e.value FUNC LOCAL () () <Pragma e.pos>;
540    } :: e.name s.tag s.linkage t.in t.out t.pragma,
541    {
542      <? &Traceall?> : v =
543        (TRACE <Make-Name e.name>);;
544    } :: e.trace,
545    {
546      s.linkage : EXTERN = EXPORT;
547      s.linkage;
548    } :: s.linkage,
549    (s.linkage s.tag t.pragma <Make-Name e.name> t.in t.out
550      (BRANCH <Pragma e.pos> e.items)
551    )
552    e.trace;
553
554Parse-Alt e.colon-pos // = e.items
555  =
556  <Expect-Token LBRACE TLBRACE EMPTY> :: (e.pos) (s.type e.value),
557  {
558    s.type : EMPTY = <Parse-Sentence e.colon-pos>;
559    (e.pos) /*empty*/ $iter
560      {
561        e.items (BRANCH <Pragma e.snt-end-pos> <Parse-Sentence e.colon-pos>)
562        :: e.items,
563          <Expect-Token SEMICOLON> :: (e.snt-end-pos) t,
564          (e.snt-end-pos) e.items;
565      } :: (e.snt-end-pos) e.items,
566        <Expect-Token RBRACE EMPTY> : (e) (RBRACE e),
567        {
568          e.items : = (LEFT <Pragma e.pos>);
569          {
570            s.type : LBRACE = (BLOCK <Pragma e.pos> e.items);
571            (BLOCK? <Pragma e.pos> e.items);
572          };
573        };
574  };
575
576Parse-Sentence e.colon-pos // = e.items
577  =
578//<WriteLN Parse-Sentence>,
579    <Parse-Pattern e.colon-pos> :: e.pattern,
580    <Parse-Tail> :: e.tail,
581    e.pattern e.tail;
582
583Tail? // [] = []
584  = <Expect-Token COMMA NOT STAKE CUT FAIL EQUAL ERROR TRAP EMPTY> ::
585    (e.pos) (s.type e.value),
586    \{
587      s.type : EMPTY = $fail;
588      <Unget-Token (e.pos) (s.type e.value)>;
589    };
590
591Parse-Tail // [] = e.items
592  =
593//<WriteLN Parse-Tail>,
594    <Expect-Token COMMA NOT STAKE CUT FAIL EQUAL ERROR TRAP EMPTY> ::
595      (e.pos) (s.type e.value),
596    s.type :
597      {
598        COMMA = <Parse-Path>;
599        NOT = (NOT (BRANCH <Pragma e.pos> <Parse-Source>)) <Parse-Tail>;
600        STAKE = (STAKE <Pragma e.pos>) <Parse-Path>;
601        CUT = (CUT <Pragma e.pos>) <Parse-Path>;
602        FAIL = (FAIL <Pragma e.pos>);
603        EQUAL = (CUTALL <Pragma e.pos>) <Parse-Path>;
604        ERROR = (ERROR <Pragma e.pos>) <Parse-Path>;
605        TRAP = <Parse-Path> :: e.try,
606          <Expect-Token WITH> : e,
607          (TRY (BRANCH <Pragma e.pos> e.try) <Parse-Alt>);
608        EMPTY = (RESULT <Pragma e.pos>);
609      };
610
611Parse-Path // [] = e.item
612  =
613//<WriteLN Parse-Path>,
614  {
615    <Tail?>, <Parse-Tail>;
616    <Parse-Source> :: e.source,
617      {
618        <Tail?>, <Parse-Tail>;
619        <Expect-Token DCOLON ITER COLON EMPTY> :: (e.pos) (s.type e),
620          s.type : {
621            DCOLON = (FORMAT <Pragma e.pos> <Parse-Hard-Expr>) <Parse-Tail>;
622            ITER = <Parse-Source> :: e.body,
623              {
624                <Tail?> =
625                  (ITER
626                    (BRANCH <Pragma e.pos> e.body)
627                    (FORMAT <Pragma e.pos>)
628                    (BRANCH <Pragma e.pos> <Parse-Tail>)
629                  );
630                <Expect-Token DCOLON> :: (e.dcolon-pos) t,
631                  (ITER
632                    (BRANCH <Pragma e.pos> e.body)
633                    (FORMAT <Pragma e.dcolon-pos> <Parse-Hard-Expr>)
634                    (BRANCH <Pragma e.dcolon-pos> <Parse-Tail>)
635                  );
636              };
637            COLON = <Parse-Alt e.pos>;
638            EMPTY = ;
639          };
640      } :: e.items,
641      e.source e.items;
642  };
643
644Parse-Source // [] = e.item
645  =
646  <Expect-Token LBRACE TLBRACE EMPTY> :: (e.pos) (s.type e),
647  {
648    s.type :
649      \{
650        LBRACE;
651        TLBRACE;
652      } =
653        (e.pos) /*empty*/ $iter
654          {
655            e.items (BRANCH <Pragma e.snt-end-pos> <Parse-Path>) :: e.items,
656              <Expect-Token SEMICOLON> :: (e.snt-end-pos) t,
657              (e.snt-end-pos) e.items;
658          } :: (e.snt-end-pos) e.items,
659            <Expect-Token RBRACE EMPTY> : (e) (RBRACE e),
660            {
661              s.type : LBRACE = (BLOCK <Pragma e.pos> e.items);
662              (BLOCK? <Pragma e.pos> e.items);
663            };
664    (RESULT <Pragma e.pos> <Parse-Result>);
665  } :: e.items,
666  e.items <Expect-Token COLON EMPTY> $iter {
667    <Expect-Token LBRACE TLBRACE EMPTY> :: (e.p) (s.t e.v),
668      <Unget-Token (e.p) (s.t e.v)>,
669      s.t : \{ LBRACE; TLBRACE; } =
670      e.items <Parse-Alt e.pos> <Expect-Token COLON EMPTY>;
671    <Unget-Token (e.pos) (s.type e.value)>,
672      e.items (e.pos) (EMPTY);
673  } :: e.items (e.pos) (s.type e.value),
674  s.type : EMPTY =
675  e.items;
676
677Parse-Result // [] = e.items
678  =
679//<WriteLN Parse-Result>,
680  {
681    <Parse-Result-Term> : v.term =
682      v.term <Parse-Result>;
683    ;
684  };
685
686Parse-Result-Term // [] = e.items
687  =
688//<WriteLN Parse-Result-Term>,
689    <Expect-Token SYMBOLS NUMBER WORD QWORD REF LPAREN
690      EVAR VVAR TVAR SVAR LBRACKET EMPTY>
691    :: (e.pos) (s.type e.value),
692    {
693      s.type : EMPTY = ;
694      s.type : SYMBOLS = e.value;
695      s.type : NUMBER = e.value;
696      s.type : REF = <Parse-Ref>;
697      s.type : LPAREN =
698        <Parse-Result> :: e.items,
699        <Expect-Token RPAREN> : e, (PAREN e.items);
700      s.type :
701        \{
702          EVAR;
703          VVAR;
704          TVAR;
705          SVAR;
706        } = (s.type <Pragma e.pos> <Make-Name e.value>);
707      s.type : WORD = <Canonical-Word e.value>;
708      s.type : QWORD = <To-Word e.value>;
709      s.type : LBRACKET =
710        <Expect-Token WORD QWORD> :: (e.pos) (s.type e.value),
711        <Canonical-Name s.type e.value> :: e.uniname,
712        {
713          <Lookup-Name (e.pos) (e.uniname)> :: e.name =
714            <Lookup &Names e.name>
715            : (e.decl-pos) (e.origname) s.decl-type e.nameinfo =
716              {
717                s.decl-type :
718                  \{
719                    FUNC e;
720                    FUNC? e;
721                    TFUNC e;
722                  } = e.origname;
723                <RFP-Error (e.pos) ("\'" e.name "\' is not a function")>,
724                  <RFP-Error (e.decl-pos)
725                    ("  '" e.name "' is declared here as "
726                      s.decl-type)>,
727                  e.origname;
728              };
729          <RFP-Error (e.pos) ("Undefined name \'" e.value "\'" )>,
730            e.value;
731        } :: e.name,
732        (CALL <Pragma e.pos> <Make-Name e.name> <Parse-Result>) :: e.items,
733        <Expect-Token RBRACKET> : e, e.items;
734    };
735
736Parse-Pattern e.colon-pos // = e.items
737  =
738  <Expect-Token L R EMPTY> : (e.pos) (s.type e),
739  (e.colon-pos) (e.pos) : e (v.p) e,
740  {
741    s.type : R = (RIGHT <Pragma v.p> <Parse-Pattern-Expr>);
742    (LEFT <Pragma v.p> <Parse-Pattern-Expr>);
743  };
744
745Parse-Pattern-Expr // [] = e.items
746  =
747//<WriteLN Parse-Pattern-Expr>,
748  {
749    <Parse-Pattern-Term> : v.term =
750      v.term <Parse-Pattern-Expr>;
751    ;
752  };
753
754Parse-Pattern-Term // [] = e.items
755  =
756//<WriteLN Parse-Pattern-Term>,
757    <Expect-Token SYMBOLS NUMBER WORD QWORD REF LPAREN EVAR VVAR TVAR SVAR EMPTY>
758    :: (e.pos) (s.type e.value),
759    {
760      s.type : EMPTY = ;
761      s.type : SYMBOLS = e.value;
762      s.type : NUMBER = e.value;
763      s.type : WORD = <Canonical-Word e.value>;
764      s.type : QWORD = <To-Word e.value>;
765      s.type : REF = <Parse-Ref>;
766      s.type : LPAREN =
767        <Parse-Pattern-Expr> :: e.items,
768        <Expect-Token RPAREN> : e, (PAREN e.items);
769      s.type :
770        \{
771          EVAR;
772          VVAR;
773          TVAR;
774          SVAR;
775        } = (s.type <Pragma e.pos> <Make-Name e.value>);
776    };
777
778Parse-Ref // [] = e.items
779  = <Expect-Token WORD QWORD> :: (e.pos) (s.type e.value),
780    <Canonical-Name s.type e.value> :: e.uniname,
781    {
782      <Lookup-Name (e.pos) (e.uniname)> :: e.name =
783        <Lookup &Names e.name> :
784          (e.decl-pos) (e.origname) s.decl-type e.nameinfo,
785        (REF <Make-Name e.origname>);
786      <RFP-Error (e.pos) ("Undefined name \'" e.value"\'" )>,
787        (REF <Make-Name e.value>);
788    };
789
790Make-Name // e.sname = t.name
791  e.sname = (<Make-Name2 <To-Chars e.sname>>);
792
793Make-Name2// e.sname = e.name
794{
795  e.item '.' e.rest = <To-Word e.item> <Make-Name2 e.rest>;
796  e.item = <To-Word e.item>;
797};
798
799Canonical-Name s.type e.name, {
800  s.type : WORD, <In-Table? &RFP-Options CASE-INSENSITIVE> = <To-Upper e.name>;
801  e.name;
802};
803
804Canonical-Word e.value, {
805  <In-Table? &RFP-Options CASE-INSENSITIVE> = <To-Word <To-Upper e.value>>;
806  <To-Word e.value>;
807};
808
809Pragma s.idx s s.line s.col =
810    (PRAGMA (FILE <RFP-Source-File-Name s.idx>) (LINE s.line s.col));
811
Note: See TracBrowser for help on using the repository browser.