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

Last change on this file since 2043 was 2043, checked in by orlov, 14 years ago
  • Improved block extraction from result expressions.
  • Use asail2asail when converting to C++.
  • Remove duplicate declarations after cleanup of blocks

(rfp_asail2asail.Remove-Dupl-Decl).

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