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

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