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

Last change on this file since 1920 was 1920, checked in by orlov, 15 years ago
  • Code formatting + small TFUNC fix.
  • 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: 1920 $
20// $Date: 2006-04-10 18:21:09 +0000 (Mon, 10 Apr 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
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    '$tfunc' =
279      {
280        <In-Table? &RFP-Options TPP> = TFUNC;
281        <RFP-Error (<Token-Position>) ("Incorrect using of t-function \n")>,
282          TFUNC;
283      };
284    '$extern' = EXTERN;
285    '$iter' = ITER;
286    '$l' = L;
287    '$r' = R;
288    '$string' = STRING;
289    '$table' = TABLE;
290    '$trace' = TRACE;
291    '$traceall' = TRACEALL;
292    '$trap' = TRAP;
293    '$use' = USE;
294    '$vector' = VECTOR;
295    '$with' = WITH;
296  } :: s.key,
297  (s.key) (e.line);
298
299Scan-Keyword-Rest (e.start) (e.line) =
300  (e.start) (e.line) T $iter {
301    e.l : s.first e.rest,
302      \{
303        <Letter? s.first>;
304        s.first : \{
305          '?';
306          '!';
307        };
308      },
309      <Next-Column>,
310      (e.w s.first) (e.rest) T;
311    (e.w) (e.l) F;
312  } :: (e.w) (e.l) s.cond,
313  s.cond : F,
314  (e.w) (e.l) ;
315
316Scan-Variable? e.line =
317  e.line : s.first e.rest,
318  s.first : \{
319    's', SVAR;
320    'e', EVAR;
321    'v', VVAR;
322    't', TVAR;
323  } :: s.type,
324  <Next-Column>,
325  {
326    e.rest : '.' e.rest2 = <Next-Column>,
327      <Scan-Identifier-Rest Var () (e.rest2)>;
328    <Scan-Identifier-Rest Var () (e.rest)>;
329  } :: (e.name) (e.new-line),
330  {
331    e.name : = <? &Position> : s.r s.c,
332      (s.type '!!tmp-' <To-Chars <Source-File-Name> '-' s.r '-' s.c>)
333      (e.new-line);
334    (s.type e.name) (e.new-line);
335  };
336
337Scan-Number? e.line =
338  e.line : s.first e.rest,
339  \{
340    \{
341      <Digit? s.first>;
342      s.first : \{
343        '+';
344        '-';
345      };
346    },
347    <Next-Column>,
348    <Scan-Number-Rest (s.first) (e.rest)> :: (e.num) (e.rest),
349    (NUMBER <To-Int e.num>)(e.rest);
350  };
351
352Scan-Number-Rest (e.start) (e.line) = {
353  e.line : '\\' = <Scan-Number-Rest (e.start) (<Get-Source-Line>)>;
354  (e.start) (e.line) T $iter {
355    e.l : s.first e.rest,
356      <Digit? s.first>,
357      <Next-Column>,
358      (e.w s.first) (e.rest) T;
359    (e.w) (e.l) F;
360  } :: (e.w) (e.l) s.cond,
361  s.cond : F,
362  (e.w) (e.l) ;
363};
364
365Scan-Identifier? e.line =
366  e.line : s.first e.rest,
367  \{
368    \{
369      <Uppercase-Letter? s.first>;
370      s.first : \{
371        '?';
372        '!';
373      };
374    },
375    <Next-Column>,
376    <Scan-Identifier-Rest Fun (s.first) (e.rest)> :: (e.word) (e.rest),
377    (WORD e.word) (e.rest);
378  };
379
380Scan-Identifier-Rest s.obj (e.start) (e.line) =
381  s.obj : {
382    Var = '?!-' ;
383    Fun = '?!-.';
384  } :: e.extra,
385  (e.start) (e.line) T $iter {
386    e.l : s.first e.rest,
387      \{
388        <Letter? s.first>;
389        <Digit? s.first>;
390        e.extra : e s.first e;
391      },
392      <Next-Column>,
393      (e.w s.first) (e.rest) T;
394    (e.w) (e.l) F;
395  } :: (e.w) (e.l) s.cond,
396  s.cond : F =
397  {
398//    <In-Table? &RFP-Options CASE-INSENSITIVE> = (<To-Upper e.w>) (e.l);
399    (e.w) (e.l);
400  };
401
402Scan-Word? e.line =
403  e.line : '\"' e.rest,
404  \{
405    <Next-Column>,
406    <Scan-String-Rest () (e.rest) '\"'> :: (e.word) (e.rest),
407    (QWORD e.word) (e.rest);
408  };
409
410Scan-String? e.line =
411  e.line : '\'' e.rest,
412  \{
413    <Next-Column>,
414    <Scan-String-Rest () (e.rest) '\''> :: (e.str) (e.rest),
415    (SYMBOLS e.str) (e.rest);
416  };
417
418Scan-String-Rest (e.start) (e.line) s.term =
419  (e.start) (e.line) T $iter {
420    e.l : s.first e.rest,
421      <Next-Column>,
422      s.first : {
423        s.term = (e.s) (e.rest) F;
424        '\\' = {
425          e.rest : s.first2 e.rest2,
426            <Next-Column>,
427            s.first2 : \{
428              't' = (e.s '\t') (e.rest2) T;
429              'n' = (e.s '\n') (e.rest2) T;
430              'r' = (e.s '\r') (e.rest2) T;
431              '\\' = (e.s '\\') (e.rest2) T;
432              '\'' = (e.s '\'') (e.rest2) T;
433              '\"' = (e.s '\"') (e.rest2) T;
434              s = <RFP-Warning (<Token-Position>)
435                ("Unknown control sequence \'\\" s.first2 "\'")>,
436                (e.s s.first2) (e.rest2) T;
437            };
438          (e.s) (<Get-Source-Line>) T;
439          <RFP-Error (<Token-Position>) (Error "Unterminated string detected")>,
440            (e.s) () F;
441        };
442        s = (e.s s.first) (e.rest) T;
443      };
444    (e.s '\n') (<Get-Source-Line>) T;
445    <RFP-Error (<Token-Position>) ("Unterminated string detected")>,
446      (e.s) () F;
447  } :: (e.s) (e.l) s.cond,
448  s.cond : F,
449  (e.s) (e.l) ;
450
451Skip-Comment e.line = {
452  e.line : e1 '*/' e.rest = e.rest ;
453  <Skip-Comment <Get-Source-Line>>;
454  <RFP-Error (<Token-Position>) ("Unexpected end of file")>;
455};
456
457Next-Column =
458  <Store &Position <RFP-Next-Column <? &Position>>>;
459
460Next-Row =
461  <Store &Position <RFP-Next-Row <? &Position>>>;
462
463Uppercase-Letter? s.letter =
464  <Letter? s.letter>,
465  <"=" (<To-Upper s.letter>) (s.letter)>;
466
467Source-File-Name =
468  <? &Source> : s.srctype s.getline-func (e.name) (e.src),
469  e.name;
470
471Print-File-Name = <Print <Source-File-Name>>;
472
473Token-Position =
474  <? &Source-Index> <? &Position> ;
475
476Find-Include? e.name s.ci? =
477  <To-Upper e.name> :: e.NAME,
478  {
479    e.name : &RFP-Dir-Separator e = ();
480    e.name : '.' e = (<RFP-Dir-Name <Source-File-Name>>);
481    (<RFP-Dir-Name <Source-File-Name>>) <? &RFP-Include-Path>;
482  } :: e.path,
483  e.path : e (e.dirname) e \?
484  e.dirname : {
485    e &RFP-Dir-Separator = e.dirname;
486    v = e.dirname &RFP-Dir-Separator;
487    e = '.' &RFP-Dir-Separator;
488  } :: e.dirn,
489//  {
490//    e.name $iter { e.name : e1 '.' e2 = e1 &RFP-Dir-Separator e2; } :: e.name,
491//    # \{ e.name : e1 '.' e2; }, e.name;
492//  } :: e.name,
493  \{
494    <In-Table? &RFP-Options CASE-INSENSITIVE> \!
495      {
496        $trap <Open-Dir e.dirn> $with {
497          e = $fail;
498        };
499      } : s.dir,
500      $iter \{
501        <Read-Dir s.dir> :: e.filename, {
502          e.filename : e.basename '.rfi',
503            \{
504              e.basename : e.name;
505              s.ci? : CI, <To-Upper e.basename> : e.NAME;
506            } =
507            (<Try-Open e.dirn e.basename '.rfi'>);;
508        };
509      } :: e.res,
510      e.res : (e.source) =
511      e.source;
512    <Try-Open e.dirn e.name '.rfi'>;
513  } :: e.source,
514  e.source;
515
516Try-Open e.filename =
517  {
518    <RFP-Debug?>, <PrintLN "Trying to open \'" e.filename "\'">;;
519  },
520  <RFP-Src-Open-File e.filename> :: e.source,
521  {
522    <RFP-Debug?>, <PrintLN "\'" e.filename "\' successfully opened">;;
523  },
524  e.source;
525
526Interface-Name? FILE s (e.name) (e) =
527  e.name : \{
528    e.base '.rf' = e.base '.rfi';
529  };
Note: See TracBrowser for help on using the repository browser.