source: to-imperative/trunk/java/refal/refal/plus/Lexer.rf @ 3615

Last change on this file since 3615 was 3615, checked in by yura, 13 years ago
  • Java are splited into two packages: onlu java libraries are in refal.plus, refal+java libraries in refal.plus.internal.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 7.1 KB
Line 
1// $Id: Lexer.rf 3615 2008-03-29 22:19:28Z yura $
2
3//X/$functor Lexer (Stream : IndexedStream);
4//X/$module Err = Stream-Error (Stream);
5//X/$use Err;
6$use "IndexedStream";
7$use "Stream";
8$use "StreamErr";
9
10$use Arithm Box Class Compare Convert;
11
12
13$box Collect_Errors_Box;
14/*
15 * A number.  Initially should be 0.
16 */
17
18//** $func  Start-Collect-Errors = ;
19//** $func  Stop-Collect-Errors  = ;
20//** $func? Collecting-Errors?   = ;
21
22Start_Collect_Errors =
23  <Get &Collect_Errors_Box> : s.num,
24  <Store &Collect_Errors_Box <Add s.num 1>>;
25
26Stop_Collect_Errors =
27  <Get &Collect_Errors_Box> : {
28    0;
29    s.num = <Store &Collect_Errors_Box <Sub s.num 1>>;
30  };
31
32IsCollecting_Errors = # \{ <Get &Collect_Errors_Box> : 0; };
33
34
35
36$func? IsBlank term = ;
37
38IsBlank \{ ' '; '\t'; '\n'; '\r'; };
39
40IsSkip_Blank stream = <Get_While stream &IsBlank> : v;
41
42
43IsSkip_Comment stream =
44  { # <IsCollecting_Errors> = <Clear_Errors>;; },
45  <Getc stream> : {
46    '*' = <Get_Line stream> : e;
47    '/' =
48      <Current_Pos stream> :: t.pos,
49      {
50        <Getc stream> : {
51          '/' = <Get_Line stream> : e;
52          '*' =
53            $iter {
54              <Get_Delim stream '*'> : v, {
55                <Getc stream> : {
56                  '/' = Stop;
57                  t;
58                };
59                <Error_At t.pos "Unclosed comment">, Stop;
60              };
61              <Error_At t.pos "Unclosed comment">, Stop;
62            } :: e.Isstop,
63            e.Isstop : Stop;
64          t1  =
65            <Error stream "Invalid character '" t1 "'">,
66            $fail;
67        };
68        <Error_At t.pos "Unexpected end of file"> = $fail;
69      };
70    t1  = <Ungets stream t1>, $fail;
71  };
72
73
74$func? IsVar_Sym term = ;
75
76IsVar_Sym sym =
77  \{
78    <IsLetter sym>;
79    <IsDigit sym>;
80    '-?!' : e sym e;
81  };
82
83
84IsScan_Keyword stream =
85  <Getc stream> : {
86    '$';
87    t1 = <Ungets stream t1>, $fail;
88  },
89  <Get_While stream &IsVar_Sym> :: e.ident,
90  {
91    <Get &Case_Insensitive> : 1 = <ToLower e.ident>;
92    e.ident;
93  } : {
94    'box' = BOX;
95    'channel' = CHANNEL;
96    'const' = CONST;
97    'error' = ERROR;
98    'fail' = FAIL;
99    'func' = FUNC;
100    'func?' = "FUNC?";
101    'iter' = ITER;
102    'l' = L;
103    'r' = R;
104    'string' = STRING;
105    'table' = TABLE;
106    'trace' = TRACE;
107    'traceall' = TRACEALL;
108    'trap' = TRAP;
109    'use' = USE;
110    'vector' = VECTOR;
111    'with' = WITH;
112    e1 = <Ungets stream '$' e1>, $fail;
113  };
114
115
116IsScan_Number stream =
117  <Getc stream> : s.first,
118  {
119    <IsDigit s.first>;
120    s.first : \{ '+'; '-'; };
121    <Ungets stream s.first> = $fail;
122  },
123  NUMBER s.first <Get_While stream &IsDigit>;
124
125
126IsScan_Variable stream =
127  <Getc stream> : {
128    's', SVAR;
129    'e', EVAR;
130    'v', VVAR;
131    't', TVAR;
132    t1 = <Ungets stream t1>, $fail;
133  } :: s.type,
134  <Getc stream> : {
135    '.' = <Get_While stream &IsVar_Sym>;
136    s1, <IsVar_Sym s1> = s1 <Get_While stream &IsVar_Sym>;
137    t1 = <Ungets stream t1>, /*empty*/;
138  } :: e.name,
139  {
140//    e.name : /*empty*/ =
141//      s.type '!!tmp-' <To-Chars <Name stream> '-' <Row stream> '-' <Column stream>>;
142    s.type e.name;
143  };
144
145
146$func? IsUppercase_Letter s.letter = ;
147$func? IsFun_Sym term = ;
148
149IsScan_Identifier stream =
150  <Getc stream> : s.first,
151  {
152    \{
153      <IsUppercase_Letter s.first>;
154      '_' : s.first;
155    } =
156      WORD s.first <Get_While stream &IsFun_Sym>;
157    <Ungets stream s.first> = $fail;
158  };
159
160IsUppercase_Letter s.letter =
161  <IsLetter s.letter>,
162  <Eq (<ToUpper s.letter>) (s.letter)>;
163
164IsFun_Sym sym =
165  \{
166    <IsLetter sym>;
167    <IsDigit sym>;
168    '_.' : e sym e;
169  };
170
171
172$func Scan_String_Rest t.pos s.max s.term stream = e.characters;
173
174IsScan_Quoted_Word stream =
175  { # <IsCollecting_Errors> = <Clear_Errors>;; },
176  <Current_Pos stream> :: t.pos,
177  <Getc stream> : {
178    '\"' = QWORD <Scan_String_Rest t.pos -1 '\"' stream>;
179    t1   = <Ungets stream t1>, $fail;
180  };
181
182IsScan_String stream =
183  { # <IsCollecting_Errors> = <Clear_Errors>;; },
184  <Current_Pos stream> :: t.pos,
185  <Getc stream> : {
186    '\'' = SYMBOLS <Scan_String_Rest t.pos -1 '\'' stream>;
187    t1   = <Ungets stream t1>, $fail;
188  };
189
190IsScan_Char stream =
191  { # <IsCollecting_Errors> = <Clear_Errors>;; },
192  <Current_Pos stream> :: t.pos,
193  <Getc stream> : {
194    '\'' =
195      <Scan_String_Rest t.pos 1 '\'' stream> : {
196        v.str =
197          <Ungets stream '\''>,
198          SYMBOLS v.str;
199        empty =
200          SYMBOLS /*empty*/;
201      };
202    t1   = <Ungets stream t1>, $fail;
203  };
204
205Scan_String_Rest t.pos s.max s.term stream =
206  (/*e.s*/) s.max $iter {
207    <Getc stream> : {
208      s.term = (e.s) 0;
209      '\\' = {
210        <Getc stream> : {
211          'n'  = (e.s '\n') <Sub s.max 1>;
212          't'  = (e.s '\t') <Sub s.max 1>;
213          'v'  = (e.s '\v') <Sub s.max 1>;
214          'b'  = (e.s '\b') <Sub s.max 1>;
215          'r'  = (e.s '\r') <Sub s.max 1>;
216          'f'  = (e.s '\f') <Sub s.max 1>;
217          '\\' = (e.s '\\') <Sub s.max 1>;
218          '\'' = (e.s '\'') <Sub s.max 1>;
219          '\"' = (e.s '\"') <Sub s.max 1>;
220          '\n' = (e.s) s.max;
221          s1   =
222            <Error stream "Unknown control sequence '\\" s1 "'">,
223            (e.s s1) <Sub s.max 1>;
224          t1   =
225            <Error stream "Bad symbol '" t1 "'">, (e.s) s.max;
226        };
227        <Error_At t.pos "Unclosed quotes">, (e.s) 0;
228      };
229      '\n' = (e.s '\n') <Sub s.max 1>; //FIXME: should be option-controlled!
230      s1 = (e.s s1) <Sub s.max 1>;
231      t1 = <Error stream "Invalid character '" t1 "'">, (e.s) s.max;
232    };
233    <Error_At t.pos "Unclosed quotes">, (e.s) 0;
234  } :: (e.s) s.max,
235  s.max : 0 =
236  e.s;
237
238
239$box Parenth_Level;
240
241$func? Read_Term_Aux stream = term;
242
243IsRead_Term stream =
244  <Start_Collect_Errors>,
245  <Store &Parenth_Level 0>,
246  {
247    <Read_Term_Aux stream> :: term =
248      <Stop_Collect_Errors>,
249      term;
250    <Stop_Collect_Errors> = $fail;
251  };
252
253Read_Term_Aux stream =
254  $iter {
255    <IsSkip_Blank stream>;
256    <IsSkip_Comment stream>;
257    Stop;
258  } :: e.Isstop,
259  e.Isstop : Stop =
260  \{
261    <Current_Pos stream> :: t.pos,
262      <Getc stream> : \{
263        '(' =
264          <Get &Parenth_Level> : s.level,
265          <Store &Parenth_Level <Add s.level 1>>,
266          /*e.terms*/ (/*e.last*/) $iter {
267            e.terms e.last (<Read_Term_Aux stream>);
268            <Error_At t.pos "Unclosed parentheses"> = $fail;
269          } :: e.terms (e.last),
270          <Get &Parenth_Level> : s.level =
271          (e.terms);
272        ')' =
273          <Get &Parenth_Level> : s.level,
274          {
275            <Gt (s.level) (0)> =
276              <Store &Parenth_Level <Sub s.level 1>>,
277              ("Time-To-Close-Parentheses");
278            <Error stream "Unexpected right parenthesis"> = $fail;
279          };
280        t1, <Ungets stream t1>, $fail;
281      };
282    \{
283      <IsScan_Identifier  stream>;
284      <IsScan_Quoted_Word stream>;
285      <IsScan_Char        stream>;
286      <IsScan_Number      stream>;
287    } : s.type e.value,
288      s.type : {
289        WORD =
290          {
291            <Get &Case_Insensitive> : 1 = <ToWord <ToUpper e.value>>;
292            <ToWord e.value>;
293          };
294        QWORD = <ToWord e.value>;
295        SYMBOLS =
296          \{
297            e.value : symbol, symbol;
298            <Read_Term_Aux stream>;
299          };
300        NUMBER = <ToInt e.value>;
301      };
302    <Getc stream> : t1 =
303      <Error stream "Invalid character '" t1 "'">,
304      <Read_Term_Aux stream>;
305  };
306
Note: See TracBrowser for help on using the repository browser.