source: to-imperative/trunk/compiler/rfp_lex.rf @ 1825

Last change on this file since 1825 was 1825, checked in by orlov, 15 years ago
  • Added proper generation of imports in Java code.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 13.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: 1825 $
20// $Date: 2005-12-29 01:57:15 +0000 (Thu, 29 Dec 2005) $
21// Author: Andrey Slepuhin <pooh@msu.ru>
22
23// rfp_lex.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 StdIO;
30$use Box ;
31$use Dir ;
32$use Dos ;
33$use Arithm ;
34$use Class ;
35$use Access ;
36$use Compare ;
37$use Convert ;
38$use Table ;
39
40$box Source ;
41$box Position ;
42$box Source-Index ;
43$box Saved-Sources ;
44$box Src-Counter ;
45
46$func? Get-Source-Line = e.line ;
47$func Scan-Token e.line = (e.tokens) (e.new-line) ;
48$func Scan-Tokens e.line = e.tokens ;
49$func? Blank? s.char = ;
50$func? Skip-Blank e.line = e.new-line ;
51$func Next-Column = ;
52$func Next-Row = ;
53$func? Uppercase-Letter? s.letter = ;
54$func Source-File-Name = e.name ;
55$func Print-File-Name = ;
56$func Token-Position = e.position;
57$func? Scan-Number? e.line = (e.num) (e.new-line) ;
58$func Scan-Number-Rest (e.start) (e.line) = (e.num) (e.new-line) ;
59$func? Scan-Keyword? e.line = (e.token) (e.new-line) ;
60$func Scan-Keyword-Rest (e.start) (e.line) = (e.keyword) (e.new-line) ;
61$func? Scan-Variable? e.line = (e.token) (e.new-line) ;
62$func? Scan-Identifier? e.line = (e.token) (e.new-line) ;
63$func Scan-Identifier-Rest s.obj (e.start) (e.line) = (e.word) (e.new-line) ;
64$func? Scan-Word? e.line = (e.token) (e.new-line) ;
65$func? Scan-String? e.line = (e.token) (e.new-line) ;
66$func Scan-String-Rest (e.start) (e.line) s.term = (e.string) (e.new-line) ;
67$func? Skip-Comment e.line = e.new-line ;
68$func? Find-Include? e.name s.case-insensitive? = e.source ;
69$func? Try-Open e.filename = e.source ;
70$func? Interface-Name? e.source = e.iname ;
71
72$func Push-Source e.source s.type s.row s.column = ;
73$func? Pop-Source? = ;
74
75RFP-Lexer e.filename =
76  <Store &Source>,
77  <Store &Saved-Sources>,
78  <Store &Position>,
79  <Store &Source-Index>,
80  <Store &Src-Counter 0>,
81  <RFP-Clear-Table &RFP-Sources>,
82  {
83    e.filename : v, {
84      <RFP-Src-Open-File e.filename>;
85      <PrintLN! &StdErr 'Error: cannot open source file ' e.filename>,
86        <Exit 1>;
87    };
88    <RFP-Src-Open-StdIN>;
89  } :: e.source,
90  {
91    e.source : e (e '.rfi') (e) = <Push-Source e.source I 0 1>;
92    <Push-Source e.source S 0 1>;
93  },
94  {
95    <RFP-Src-Open-File <Interface-Name? e.source>> :: e.source,
96      <Push-Source e.source I 0 1>, <Scan-Tokens>;;
97  } :: e.ts,
98  e.ts <Scan-Tokens>;
99
100Push-Source e.source s.type s.row s.col =
101  <? &Src-Counter> : s.n,
102  <"+" s.n 1> :: s.n,
103  <Store &Src-Counter s.n>,
104  <Store &Saved-Sources
105    <? &Saved-Sources> (<? &Source> <? &Source-Index> <? &Position>)
106  >,
107  <Store &Source e.source>,
108  <Bind &RFP-Sources (s.n) (<Source-File-Name>)>,
109  <Store &Source-Index s.n s.type>,
110  <Store &Position s.row s.col>;
111
112Pop-Source? =
113  <RFP-Src-Close <? &Source>>,
114  <? &Saved-Sources> : e1,
115  e1 : $r e.saved (e.source s.n s.type s.row s.col),
116  <Store &Saved-Sources e.saved>,
117  <Store &Source e.source>,
118  <Store &Source-Index s.n s.type>,
119  <Store &Position s.row s.col>;
120
121Scan-Tokens e.line =
122  <Scan-Token e.line> :: (e.t) (e.line),
123  e.t : {
124    ((e) (EOF)) =
125      {
126        <Pop-Source?>;
127        e.t;
128      };
129    ((e) (USE)), # <In-Table? &RFP-Options NO-ELABORATE> = {
130      () (e.line) T $iter {
131        <Scan-Token e.line> :: (e.t) (e.line),
132        e.t : {
133          ((e) (SEMICOLON)) = (e.nts) (e.line) F;
134          ((e.p) (s.WORD-or-QWORD e.s)) =
135            {
136              <Lookup &RFP-Module-Subst e.s>;
137              e.s;
138            } :: e.s,
139            {
140              s.WORD-or-QWORD : WORD = CI;
141              NOT-CI;
142            } :: s.ci?,
143            {
144              <RFP-Debug?>, <PrintLN "Processing " e.s>;;
145            },
146            {
147              <Find-Include? e.s s.ci?> :: e.include,
148                <Push-Source e.include I 0 1>,
149                e.nts <Scan-Tokens>;
150              <RFP-Error (e.p) ("Unable to find include file \'" e.s ".rfi\'")>,
151                e.nts;
152            } :: e.nts,
153            (e.nts) (e.line) T;
154        };
155      } :: (e.nts) (e.line) s1,
156      s1 : F,
157      e.nts <Scan-Tokens e.line>;
158    };
159    e = e.t <Scan-Tokens e.line>;
160  };
161
162Scan-Token e.line =
163  e.line :
164  {
165    = {
166        <Get-Source-Line> :: e.line,
167          <Scan-Token e.line>;
168        (((<Token-Position>) (EOF))) ();
169    };
170    s.char e.rest = <Token-Position> :: e.saved-position,
171    {
172      <Blank? s.char> =
173        <Next-Column>,
174        <Scan-Token e.rest>;
175      s.char :
176        \{
177          '(' = LPAREN;
178          ')' = RPAREN;
179          '<' = LBRACKET;
180          '>' = RBRACKET;
181          '{' = LBRACE;
182          '}' = RBRACE;
183          '#' = NOT;
184          '&' = REF;
185          ',' = COMMA;
186          ';' = SEMICOLON;
187          '=' = EQUAL;
188        } :: s.tk =
189          <Next-Column>, (((e.saved-position) (s.tk))) (e.rest);
190      s.char :
191        \{
192          ':' = <Next-Column>,
193            {
194              e.rest : ':' e.rest2 = <Next-Column>,
195                (((e.saved-position) (DCOLON))) (e.rest2);
196              (((e.saved-position) (COLON))) (e.rest);
197            };
198          '\\' = <Next-Column>,
199            {
200              e.rest : s.char2 e.rest2 = {
201                s.char2 :
202                  \{
203                    '?' = STAKE;
204                    '!' = CUT;
205                    '{' = TLBRACE;
206                  } :: s.tk =
207                    <Next-Column>, (((e.saved-position) (s.tk))) (e.rest2);
208                <RFP-Error (<Token-Position>)
209                  ("Invalid character \'" s.char2 "\'")>,
210                  <Next-Column>,
211                  <Scan-Token e.rest2>;
212              };
213              <RFP-Error (<Token-Position>) ("Unexpected end of line")>,
214                <Scan-Token>;
215            };
216          '/' = <Next-Column>, e.rest :
217            \{
218              '/' e.rest2 = <Scan-Token>;
219              '*' e.rest2 = <Scan-Token <Skip-Comment e.rest2>>;
220              s.err e.rest2 = <RFP-Error (<Token-Position>)
221                ("Invalid character \'" s.err "\'")>,
222                <Next-Column>,
223                <Scan-Token e.rest2>;
224              = <RFP-Error (<Token-Position>) ("Unexpected end of line")>,
225                <Scan-Token>;
226            };
227          '*' = <Scan-Token>;
228        };
229      \{
230        <Scan-Keyword? e.line>;
231        <Scan-Identifier? e.line>;
232        <Scan-Variable? e.line>;
233        <Scan-Word? e.line>;
234        <Scan-String? e.line>;
235        <Scan-Number? e.line>;
236      } :: (e.tk) (e.new-line),
237        (((e.saved-position) (e.tk))) (e.new-line);
238      <RFP-Error (<Token-Position>) ("Invalid character \'" s.char "\'")>,
239        <Next-Column>,
240        <Scan-Token e.rest>;
241    };
242  };
243
244Get-Source-Line =
245  <RFP-Src-Get-Line <? &Source>> :: e.line,
246  <Next-Row>,
247  e.line;
248
249Blank? s.char =
250  ' \n\t' : e s.char e;
251
252Skip-Blank e.line =
253  e.line :
254  {
255    = <Skip-Blank <Get-Source-Line>>;
256
257    s.char e.rest =
258    {
259      <Blank? s.char> = <Next-Column>, <Skip-Blank e.rest>;
260      e.line;
261    };
262  };
263
264Scan-Keyword? '$' e.rest =
265  <Next-Column>,
266  <Scan-Keyword-Rest ('$') (e.rest)> :: (e.ident) (e.line),
267  {
268    <In-Table? &RFP-Options CASE-INSENSITIVE> = <To-Lower e.ident>;
269    e.ident;
270  } : \{
271    '$box' = BOX;
272    '$channel' = CHANNEL;
273    '$const' = CONST;
274    '$error' = ERROR;
275    '$fail' = FAIL;
276    '$func' = FUNC;
277    '$func?' = FUNC?;
278    '$iter' = ITER;
279    '$l' = L;
280    '$r' = R;
281    '$string' = STRING;
282    '$table' = TABLE;
283    '$trace' = TRACE;
284    '$traceall' = TRACEALL;
285    '$trap' = TRAP;
286    '$use' = USE;
287    '$vector' = VECTOR;
288    '$with' = WITH;
289  } :: s.key,
290  (s.key) (e.line);
291
292Scan-Keyword-Rest (e.start) (e.line) =
293  (e.start) (e.line) T $iter {
294    e.l : s.first e.rest,
295      \{
296        <Letter? s.first>;
297        s.first : \{
298          '?';
299          '!';
300        };
301      },
302      <Next-Column>,
303      (e.w s.first) (e.rest) T;
304    (e.w) (e.l) F;
305  } :: (e.w) (e.l) s.cond,
306  s.cond : F,
307  (e.w) (e.l) ;
308
309Scan-Variable? e.line =
310  e.line : s.first e.rest,
311  s.first : \{
312    's', SVAR;
313    'e', EVAR;
314    'v', VVAR;
315    't', TVAR;
316  } :: s.type,
317  <Next-Column>,
318  {
319    e.rest : '.' e.rest2 = <Next-Column>,
320      <Scan-Identifier-Rest Var () (e.rest2)>;
321    <Scan-Identifier-Rest Var () (e.rest)>;
322  } :: (e.name) (e.new-line),
323  {
324    e.name : = <? &Position> : s.r s.c,
325      (s.type '!!tmp-' <To-Chars <Source-File-Name> '-' s.r '-' s.c>)
326      (e.new-line);
327    (s.type e.name) (e.new-line);
328  };
329
330Scan-Number? e.line =
331  e.line : s.first e.rest,
332  \{
333    \{
334      <Digit? s.first>;
335      s.first : \{
336        '+';
337        '-';
338      };
339    },
340    <Next-Column>,
341    <Scan-Number-Rest (s.first) (e.rest)> :: (e.num) (e.rest),
342    (NUMBER <To-Int e.num>)(e.rest);
343  };
344
345Scan-Number-Rest (e.start) (e.line) = {
346  e.line : '\\' = <Scan-Number-Rest (e.start) (<Get-Source-Line>)>;
347  (e.start) (e.line) T $iter {
348    e.l : s.first e.rest,
349      <Digit? s.first>,
350      <Next-Column>,
351      (e.w s.first) (e.rest) T;
352    (e.w) (e.l) F;
353  } :: (e.w) (e.l) s.cond,
354  s.cond : F,
355  (e.w) (e.l) ;
356};
357
358Scan-Identifier? e.line =
359  e.line : s.first e.rest,
360  \{
361    \{
362      <Uppercase-Letter? s.first>;
363      s.first : \{
364        '?';
365        '!';
366      };
367    },
368    <Next-Column>,
369    <Scan-Identifier-Rest Fun (s.first) (e.rest)> :: (e.word) (e.rest),
370    (WORD e.word) (e.rest);
371  };
372
373Scan-Identifier-Rest s.obj (e.start) (e.line) =
374  s.obj : {
375    Var = '?!-' ;
376    Fun = '?!-.';
377  } :: e.extra,
378  (e.start) (e.line) T $iter {
379    e.l : s.first e.rest,
380      \{
381        <Letter? s.first>;
382        <Digit? s.first>;
383        e.extra : e s.first e;
384      },
385      <Next-Column>,
386      (e.w s.first) (e.rest) T;
387    (e.w) (e.l) F;
388  } :: (e.w) (e.l) s.cond,
389  s.cond : F =
390  {
391//    <In-Table? &RFP-Options CASE-INSENSITIVE> = (<To-Upper e.w>) (e.l);
392    (e.w) (e.l);
393  };
394
395Scan-Word? e.line =
396  e.line : '\"' e.rest,
397  \{
398    <Next-Column>,
399    <Scan-String-Rest () (e.rest) '\"'> :: (e.word) (e.rest),
400    (QWORD e.word) (e.rest);
401  };
402
403Scan-String? e.line =
404  e.line : '\'' e.rest,
405  \{
406    <Next-Column>,
407    <Scan-String-Rest () (e.rest) '\''> :: (e.str) (e.rest),
408    (SYMBOLS e.str) (e.rest);
409  };
410
411Scan-String-Rest (e.start) (e.line) s.term =
412  (e.start) (e.line) T $iter {
413    e.l : s.first e.rest,
414      <Next-Column>,
415      s.first : {
416        s.term = (e.s) (e.rest) F;
417        '\\' = {
418          e.rest : s.first2 e.rest2,
419            <Next-Column>,
420            s.first2 : \{
421              't' = (e.s '\t') (e.rest2) T;
422              'n' = (e.s '\n') (e.rest2) T;
423              'r' = (e.s '\r') (e.rest2) T;
424              '\\' = (e.s '\\') (e.rest2) T;
425              '\'' = (e.s '\'') (e.rest2) T;
426              '\"' = (e.s '\"') (e.rest2) T;
427              s = <RFP-Warning (<Token-Position>)
428                ("Unknown control sequence \'\\" s.first2 "\'")>,
429                (e.s s.first2) (e.rest2) T;
430            };
431          (e.s) (<Get-Source-Line>) T;
432          <RFP-Error (<Token-Position>) (Error "Unterminated string detected")>,
433            (e.s) () F;
434        };
435        s = (e.s s.first) (e.rest) T;
436      };
437    (e.s '\n') (<Get-Source-Line>) T;
438    <RFP-Error (<Token-Position>) ("Unterminated string detected")>,
439      (e.s) () F;
440  } :: (e.s) (e.l) s.cond,
441  s.cond : F,
442  (e.s) (e.l) ;
443
444Skip-Comment e.line = {
445  e.line : e1 '*/' e.rest = e.rest ;
446  <Skip-Comment <Get-Source-Line>>;
447  <RFP-Error (<Token-Position>) ("Unexpected end of file")>;
448};
449
450Next-Column =
451  <Store &Position <RFP-Next-Column <? &Position>>>;
452
453Next-Row =
454  <Store &Position <RFP-Next-Row <? &Position>>>;
455
456Uppercase-Letter? s.letter =
457  <Letter? s.letter>,
458  <"=" (<To-Upper s.letter>) (s.letter)>;
459
460Source-File-Name =
461  <? &Source> : s.srctype s.getline-func (e.name) (e.src),
462  e.name;
463
464Print-File-Name = <Print <Source-File-Name>>;
465
466Token-Position =
467  <? &Source-Index> <? &Position> ;
468
469Find-Include? e.name s.ci? =
470  <To-Upper e.name> :: e.NAME,
471  {
472    e.name : &RFP-Dir-Separator e = ();
473    e.name : '.' e = (<RFP-Dir-Name <Source-File-Name>>);
474    (<RFP-Dir-Name <Source-File-Name>>) <? &RFP-Include-Path>;
475  } :: e.path,
476  e.path : e (e.dirname) e \?
477  e.dirname : {
478    e &RFP-Dir-Separator = e.dirname;
479    v = e.dirname &RFP-Dir-Separator;
480    e = '.' &RFP-Dir-Separator;
481  } :: e.dirn,
482//  {
483//    e.name $iter { e.name : e1 '.' e2 = e1 &RFP-Dir-Separator e2; } :: e.name,
484//    # \{ e.name : e1 '.' e2; }, e.name;
485//  } :: e.name,
486  \{
487    <In-Table? &RFP-Options CASE-INSENSITIVE> \!
488      {
489        $trap <Open-Dir e.dirn> $with {
490          e = $fail;
491        };
492      } : s.dir,
493      $iter \{
494        <Read-Dir s.dir> :: e.filename, {
495          e.filename : e.basename '.rfi',
496            \{
497              e.basename : e.name;
498              s.ci? : CI, <To-Upper e.basename> : e.NAME;
499            } =
500            (<Try-Open e.dirn e.basename '.rfi'>);;
501        };
502      } :: e.res,
503      e.res : (e.source) =
504      e.source;
505    <Try-Open e.dirn e.name '.rfi'>;
506  } :: e.source,
507  {
508    <? &RFP-Boot-Path> :: e.tmp, e.tmp : e (e.dirname) e =
509      <Bind &RFP-Includes (e.name) (BOOT e.dirn)>;
510    <Bind &RFP-Includes (e.name) (LOCAL e.dirn)>;
511  },
512  e.source;
513
514Try-Open e.filename =
515  {
516    <RFP-Debug?>, <PrintLN "Trying to open \'" e.filename "\'">;;
517  },
518  <RFP-Src-Open-File e.filename> :: e.source,
519  {
520    <RFP-Debug?>, <PrintLN "\'" e.filename "\' successfully opened">;;
521  },
522  e.source;
523
524Interface-Name? FILE s (e.name) (e) =
525  e.name : \{
526    e.base '.rf' = e.base '.rfi';
527  };
Note: See TracBrowser for help on using the repository browser.