source: to-imperative/trunk/compiler/rfp_asail_java.rf @ 1819

Last change on this file since 1819 was 1819, checked in by orlov, 15 years ago
  • Merged converters to C++ and Java. Not properly working yet.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 16.0 KB
Line 
1// $Id: rfp_asail_java.rf 1819 2005-12-27 11:48:51Z orlov $
2
3$use Apply Arithm Box Class Compare Convert JavaMangle List StdIO Table;
4$use "rfpc";
5$use "rfp_helper";
6
7$box Int;
8
9$box Exports;
10
11$box Module-Name;
12
13$box Entry;
14
15$box Entry-Name;
16
17$box Current-Namespace;
18
19$box Func-Name;
20
21$box Return-Type;
22
23$box Ress;
24
25$table Iter-Vars;
26
27$func ASAIL-To-Java e.body = e.java-code;
28
29$func Expr-To-Java (e.ASAIL-Expr-init ) e.ASAIL-Expr-rest = e.aux-arrays (e.java-expr);
30
31$func Expr-Ref-To-Java e.ASAIL-Expr-Ref = e.aux-arrays (e.JAVA-Expr-Ref);
32
33$func Expr-Int-To-Java s.acc e.ASAIL-Expr-Int = e.JAVA-Expr-Int;
34
35$func Step-To-Java e.step-operators = e.java-step-operators;
36
37$func Const-Expr-To-Java e.ASAIL-const-expr = e.aux-arrays (e.JAVA-const-expr);
38
39$func Expr-Args-To-Java e.args = e.aux-arrays (e.java-args);
40
41$func Int-Args-To-Java s.acc e.args = e.java-args;
42
43$func Var-Args-To-Java e.args = e.java-args;
44
45$func Symbol-To-Java s.RFP-Symbol = e.JAVA-String;
46
47$func Name-To-Java t.name = e.JAVA-Name;
48
49$func Cond-To-Java s.acc e.cond = e.JAVA-Cond;
50
51$func Infix-To-Java s.acc s.func-for-converting-args-to-java s.op e.args = e.java-expr;
52
53$func Op-Arg-To-Java s.op = s.func-for-converting-args-to-java;
54
55$func Access-Mode t.name = e.java-access-mode;
56
57$box Free-Idx;
58
59$func Free-Index = e.free-index;
60
61$func Copy-Args (e.args) (e.ress) = (e.valid-args) e.subst;
62
63RFP-ASAIL-To-Java (e.ModuleName) (e.exports) e.asail =
64  <RFP-Clear-Table &Iter-Vars>,
65  {
66    <Store &Int <Lookup &RFP-Options INT>>;
67    <Store &Int Integer>;
68  },
69  <Store &Exports e.exports>,
70  <Store &Current-Namespace e.ModuleName>,
71  <Store &Entry (e.ModuleName Main)>,
72  <Store &Entry-Name /*empty*/>,
73  {
74    <ASAIL-To-Java e.asail> : v.java,
75      {
76        <? &Entry-Name> : v.name =
77          ('public static void main(java.lang.String[] args) {'
78            (('try {' (v.name' (new Expr ());') '}')
79             ('catch (RefalException e) {' ('System.out.println ("$error: " + e);') '}')
80            )
81          '}');;
82      } :: e.entry,
83      <Store &Module-Name <Rfp2Java e.ModuleName>>,
84      ('public class '<? &Module-Name>' {'
85        (v.java e.entry)
86       '}');;
87  };
88
89ASAIL-To-Java e.asail, {
90  e.asail : t.item e.rest, t.item : {
91    (s.tag t.name (e.args) (e.ress) e.body),
92      s.tag : \{
93        FUNC  = ('void') /*empty*/;
94        FUNC? = ('boolean') ('return true;');
95      } :: (e.return-type) e.return =
96      <Store &Free-Idx>,
97      <Store &Return-Type e.return-type>,
98      <Store &Ress e.ress>,
99      { <? &Entry> : t.name = <Store &Entry-Name <Rfp2Java t.name>>;; },
100      <RFP-Extract-Qualifiers t.name> :: (e.qualifiers) e.n,
101      <Store &Func-Name <Rfp2Java e.n>>,
102      ('static '<Access-Mode t.name>' 'e.return-type' '
103        <? &Func-Name>' ('<Var-Args-To-Java e.args e.ress>') throws RefalException')
104        ('{' (<ASAIL-To-Java e.body> e.return) '}');
105    (IF (e.cond) e.body) =
106      {
107        e.cond : (CALL t.name (e.args) (e.ress)) =
108          <Copy-Args (e.args) (e.ress)> :: (e.args) e.subst,
109          <Expr-Args-To-Java e.args <Paren e.ress>> :: e.arrays (e.args),
110          e.subst e.arrays (<Name-To-Java t.name>' ('e.args')') ();
111        <Box> :: s.acc =
112          /*empty*/ (<Cond-To-Java s.acc e.cond>) (<? s.acc>);
113      } :: e.subst (e.cond) (e.arrays),
114      e.subst e.arrays
115      ('if ('e.cond')')
116      ('{' (<ASAIL-To-Java e.body>) '}');
117    (FOR (e.cont-label) (e.break-label) (e.cond) (e.step) e.body) =
118      {
119        e.cont-label : t = <Rfp2Java (LABEL e.cont-label)> ': ';;
120      } :: e.cont,
121      {
122        e.break-label : t = <Rfp2Java (LABEL e.break-label)> ': ';;
123      } :: e.break,
124      <Box> :: s.acc,
125      <Cond-To-Java s.acc e.cond> :: e.cond,
126      <? s.acc>
127      (e.cont e.break 'for ( ; 'e.cond'; '<Step-To-Java e.step>')')
128        ('{' (<ASAIL-To-Java e.body>) '}');
129    (LABEL (e.label) e.body) =
130      (<Rfp2Java (LABEL e.label)>': {' (<ASAIL-To-Java e.body>) '}');
131    (TRY e.body) =
132      ('try') ('{' (<ASAIL-To-Java e.body>) '}');
133    (CATCH-ERROR e.body) =
134      ('catch (RefalException error) {'
135        ('Expr err = error.getExpr ();')
136        (<ASAIL-To-Java e.body>)
137       '}');
138    RETFAIL = ('return false;');
139    FATAL =
140      ('throw new RefalException ("'<? &Module-Name>'", "'<? &Func-Name>'", "Unexpected fail");');
141    (LSPLIT t.name (e.min) t.var1 t.var2) =
142      <Rfp2Java t.name> :: e.n,
143      '_va_' <Free-Index> :: e.new-var,
144      <Bind &Iter-Vars (t.name) (e.new-var)>,
145      <Box> :: s.acc,
146      <Expr-Int-To-Java s.acc e.min> :: e.min,
147      <? s.acc>
148      ('Expr.SplitIterator 'e.new-var' = 'e.n'.leftSplit('e.min');')
149      ('Expr '<Rfp2Java t.var1>' = 'e.new-var'.getLeft();')
150      ('Expr '<Rfp2Java t.var2>' = 'e.new-var'.getRight();');
151    (RSPLIT t.name (e.min) t.var1 t.var2) =
152      <Rfp2Java t.name> :: e.n,
153      '_va_' <Free-Index> :: e.new-var,
154      <Bind &Iter-Vars (t.name) (e.new-var)>,
155      <Box> :: s.acc,
156      <Expr-Int-To-Java s.acc e.min> :: e.min,
157      <? s.acc>
158      ('Expr.SplitIterator 'e.new-var' = 'e.n'.rightSplit('e.min');')
159      ('Expr '<Rfp2Java t.var1>' = 'e.new-var'.getLeft();')
160      ('Expr '<Rfp2Java t.var2>' = 'e.new-var'.getRight();');
161    (ASSIGN t.var e.expr) =
162      <Expr-To-Java () e.expr> :: e.a (e.j-expr),
163      {
164        <? &Ress> : e t.var e =
165          e.a (<Rfp2Java t.var>'.assign('e.j-expr');');
166        e.a (<Rfp2Java t.var>' = 'e.j-expr';');
167      };
168    (DECL s.type t.var) =
169      (s.type' '<Rfp2Java t.var>' = new Expr ();');
170    (INT t.var e.expr) =
171      <Box> :: s.acc,
172      <Expr-Int-To-Java s.acc e.expr> :: e.expr,
173      <? s.acc> ('int '<Rfp2Java t.var>' = 'e.expr';');
174    (EXPR t.var e.expr) =
175      <Expr-Ref-To-Java e.expr> :: e.a (e.j-expr),
176      e.a ('Expr '<Rfp2Java t.var>' = new Expr ('e.j-expr');');
177    (DEREF t.var e.expr (e.pos)) =
178      <Expr-Ref-To-Java e.expr> :: e.a (e.j-expr),
179      <Box> :: s.acc,
180      <Expr-Int-To-Java s.acc e.pos> :: e.pos,
181      e.a <? s.acc> ('Expr '<Rfp2Java t.var>' = new Expr ('e.j-expr', 'e.pos');');
182    (SUBEXPR t.var e.expr (e.pos) (e.len)) =
183      <Expr-Ref-To-Java e.expr> :: e.a (e.j-expr),
184      <Box> :: s.acc,
185      <Expr-Int-To-Java s.acc e.pos> :: e.pos,
186      <Expr-Int-To-Java s.acc e.len> :: e.len,
187      e.a <? s.acc> ('Expr '<Rfp2Java t.var>' = new Expr ('e.j-expr', 'e.pos', 'e.len');');
188    (DROP t.var) =
189      (<Rfp2Java t.var>'.drop ();');
190    (CONTINUE t.label) =
191      ('continue '<Rfp2Java (LABEL t.label)>';');
192    (BREAK t.label) =
193      ('break '<Rfp2Java (LABEL t.label)>';');
194    (ERROR e.expr) =
195      <Expr-Ref-To-Java e.expr> :: e.a (e.j-expr),
196      e.a ('throw new RefalException ('e.j-expr');');
197    (CONSTEXPR s.linkage t.name (e.comment) e.expr) =
198      {
199        t.name : (STATIC e) = t.name;
200        <RFP-Extract-Qualifiers t.name> :: (e.qualifiers) e.name = e.name;
201      } :: e.n,
202      <Const-Expr-To-Java e.expr> :: e.a (e.j-expr),
203      e.a ('static '<Access-Mode t.name>' final Expr '<Rfp2Java e.n>' = 'e.j-expr';');
204    (OBJ s.linkage s.tag t.name) =
205      <To-Chars s.tag> : s1 e2,
206      <RFP-Extract-Qualifiers t.name> :: (e.qualifiers) e.n,
207      ('static '<Access-Mode t.name>' final Expr '<Rfp2Java e.n>
208        ' = new Expr (new Named' s1 <To-Lower e2>' ("'e.n'"));');
209    (DECL-OBJ t.name) = ;
210    (DECL-FUNC t.name) = ;
211    /*
212     * s.call can be CALL or TAILCALL
213     */
214    (s.call t.name (e.args) (e.ress)) =
215      <Copy-Args (e.args) (e.ress)> :: (e.args) e.subst,
216      <Expr-Args-To-Java e.args <Paren e.ress>> :: e.arrays (e.args),
217      <Name-To-Java t.name>' ('e.args');' :: e.c,
218      {
219        s.call : TAILCALL, <? &Return-Type> : 'boolean' =
220          e.subst e.arrays ('return 'e.c);
221        e.subst e.arrays (e.c);
222      };
223  } :: e.java-item,
224    e.java-item <ASAIL-To-Java e.rest>;
225  /*empty*/;
226};
227
228Copy-Args (e.args) (e.ress) =
229  (e.args) (/*e.valid-args*/) /*e.subst*/ $iter {
230    e.args : (e1) e2, {
231      e.ress : e (e1) e =
232        '_va_' <Free-Index> :: e.new-var,
233        (e2) (e.valid-args (e.new-var))
234            e.subst ('Expr 'e.new-var' = new Expr('<Rfp2Java e1>');');
235      (e2) (e.valid-args (e1)) e.subst;
236    };
237  } :: (e.args) (e.valid-args) e.subst,
238  e.args : /*empty*/ =
239  (e.valid-args) e.subst;
240
241/*
242 * Determine type of e.expr - int or Refal.
243 */
244Expr-To-Java (e.init) e.expr-all, e.expr-all : {
245  /*empty*/ = <Expr-Ref-To-Java e.init>;
246  (PAREN e.expr) e.rest = <Expr-Ref-To-Java e.init e.expr-all>;
247  (EXPR e.expr) e.rest = <Expr-Ref-To-Java e.init e.expr-all>;
248  (DEREF e.expr) e.rest = <Expr-Ref-To-Java e.init e.expr-all>;
249  (SUBEXPR e.expr) e.rest = <Expr-Ref-To-Java e.init e.expr-all>;
250  (LENGTH e.expr) e.rest = (<Expr-Int-To-Java XXX e.init e.expr-all>);
251  (MAX e.args) e.rest = (<Expr-Int-To-Java XXX e.init e.expr-all>);
252  (MIN e.args) e.rest = (<Expr-Int-To-Java XXX e.init e.expr-all>);
253  (INFIX s.op e.args) e.rest = (<Expr-Int-To-Java XXX e.init e.expr-all>);
254  (s.var-tag (e.QualifiedName)) e.rest =
255    <Expr-To-Java (e.init (s.var-tag (e.QualifiedName))) e.rest>;
256};
257
258$func Term-Ref-To-Java s.acc term = e.term;
259
260Expr-Ref-To-Java {
261  /*empty*/ = ('Expr.empty');
262  term =
263    <Box> :: s.acc,
264    <Term-Ref-To-Java s.acc term> :: e.term,
265    <? s.acc> (e.term);
266  t1 t2 =
267    <Box> :: s.acc,
268    <Term-Ref-To-Java s.acc t1> :: e.t1,
269    <Term-Ref-To-Java s.acc t2> :: e.t2,
270    <? s.acc> ('new Expr ('e.t1', 'e.t2')');
271  expr =
272    '_va_'<Free-Index> :: e.new-var,
273    <Box> :: s.acc,
274    <Infix-To-Java s.acc &Term-Ref-To-Java "," <Paren expr>> :: e.arr-init,
275    <? s.acc>
276    ('Expr[] 'e.new-var' = { 'e.arr-init' };')
277    ('Expr.concat ('e.new-var')');
278};
279
280Term-Ref-To-Java s.acc term = term : {
281  (PAREN e.expr) =
282    <Expr-Ref-To-Java e.expr> :: e.a (e.j-expr),
283    <Put s.acc e.a>,
284    'new Expr('e.j-expr')';
285  (DEREF e.expr (e.pos)) =
286    <Expr-Ref-To-Java e.expr> :: e.a (e.j-expr),
287    <Put s.acc e.a>,
288    <Expr-Int-To-Java s.acc e.pos> :: e.pos,
289    'new Expr ('e.j-expr', 'e.pos')';
290  (SUBEXPR e.expr (e.pos) (e.len)) =
291    <Expr-Ref-To-Java e.expr> :: e.a (e.j-expr),
292    <Put s.acc e.a>,
293    <Expr-Int-To-Java s.acc e.pos> :: e.pos,
294    <Expr-Int-To-Java s.acc e.len> :: e.len,
295    'new Expr ('e.j-expr', 'e.pos', 'e.len')';
296  (REF t.name) = <Name-To-Java t.name>;
297  ERROR-EXPR = 'err';
298  (s.var-tag t.name) = <Rfp2Java (s.var-tag t.name)>;
299};
300
301Expr-Int-To-Java s.acc expr = expr : {
302//  /*empty*/ = /*empty*/;
303  s.ObjectSymbol =
304    {
305      <Int? s.ObjectSymbol> = s.ObjectSymbol;
306      $error ("Illegal int-symbol: " s.ObjectSymbol);
307        //FIXME: надо проверять, что число не
308        //       выходит за допустимые границы.
309        //       Задавать эти границы опциями.
310    };
311  (LENGTH e.expr) =
312    <Expr-Ref-To-Java e.expr> :: e.a (e.j-expr),
313    <Put s.acc e.a>,
314    e.j-expr'.getLen ()';
315  (MAX e.args) =
316    'java.lang.Math.max ('<Int-Args-To-Java s.acc e.args>')';
317  (MIN e.args) =
318    'java.lang.Math.min ('<Int-Args-To-Java s.acc e.args>')';
319  (INFIX s.op e.args) =
320    '(' <Infix-To-Java s.acc &Expr-Int-To-Java s.op e.args> ')';
321//  (REF t.name) = <Name-To-Java t.name>;
322  (s.var-tag t.name) = <Rfp2Java (s.var-tag t.name)>;
323  expr = '(' <Infix-To-Java s.acc &Expr-Int-To-Java "+" <Paren expr>> ')';
324};
325
326Cond-To-Java s.acc expr = expr : {
327  /*empty*/ = /*empty*/;
328  (SYMBOL? e.expr (e.pos)) =
329    <Expr-Ref-To-Java e.expr> :: e.a (e.j-expr),
330    <Put s.acc e.a>,
331    e.j-expr'.symbolAt ('<Expr-Int-To-Java s.acc e.pos>')';
332  (CHECK-ITER e.expr) =
333    <Lookup &Iter-Vars e.expr>'.isValid ()';
334  (EQ e.expr1 (e.expr2) (e.pos)) =
335    <Expr-Ref-To-Java e.expr1> :: e.a1 (e.j-expr1),
336    <Expr-Ref-To-Java e.expr2> :: e.a2 (e.j-expr2),
337    <Put s.acc e.a1 e.a2>,
338    e.j-expr1'.eq ('e.j-expr2', '<Expr-Int-To-Java s.acc e.pos>')';
339  (TERM-EQ e.expr1 (e.expr2) (e.pos)) =
340    <Expr-Ref-To-Java e.expr1> :: e.a1 (e.j-expr1),
341    <Expr-Ref-To-Java e.expr2> :: e.a2 (e.j-expr2),
342    <Put s.acc e.a1 e.a2>,
343    e.j-expr1'.eq ('e.j-expr2', '<Expr-Int-To-Java s.acc e.pos> ')';
344  (NOT e.cond) =
345    '!' <Cond-To-Java s.acc e.cond>;
346  (INFIX s.op e.args) =
347    '(' <Infix-To-Java s.acc <Op-Arg-To-Java s.op> s.op e.args> ')';
348  expr = '(' <Infix-To-Java s.acc &Cond-To-Java "&&" <Paren expr>> ')';
349};
350
351Infix-To-Java s.acc s.arg2java s.op e.args, {
352  e.args : (e.arg) e.rest =
353    <Apply s.arg2java s.acc e.arg> :: e.arg,
354    <Infix-To-Java s.acc s.arg2java s.op e.rest> :: e.rest,
355    {
356      e.arg : v, e.rest : v = e.arg ' ' s.op ' ' e.rest;
357      e.arg e.rest;
358    };;
359};
360
361Op-Arg-To-Java s.op, {
362  s.op : \{ "&&"; "||"; } =
363    &Cond-To-Java;
364  s.op : \{ "<"; ">"; "<="; ">="; "=="; "!="; "+"; "-"; "%"; "*"; "/"; } =
365    &Expr-Int-To-Java;
366};
367 
368Step-To-Java {
369  /*empty*/ = /*empty*/;
370  (INC-ITER e.expr) = <Lookup &Iter-Vars e.expr>'.next ()';
371  (DEC-ITER e.expr) = <Lookup &Iter-Vars e.expr>'.prev ()';
372};
373
374$func Const-Expr-Aux e.expr = (e.arrays) e.java-expr;
375
376Const-Expr-To-Java {
377  /*empty*/ = ('empty');
378  (SUBEXPR t.name s.pos s.len) = ('new Expr ('<Rfp2Java t.name>', 's.pos', 's.len')');
379                  //FIXME: надо проверять, что s.pos и s.len
380                  //       не превышают допустимых величин.
381                  //       Задавать эти величины опциями.
382  e.expr =
383    <Const-Expr-Aux () e.expr> : {
384      (e.arrays) (e1)      = e.arrays (e1);
385      (e.arrays) (e1) (e2) = e.arrays ('new Expr ('e1', 'e2')');
386    };
387};
388
389Const-Expr-Aux (e.accum) e.expr, {
390  e.expr : s.sym e.rest, <Char? s.sym> =
391    <Const-Expr-Aux (e.accum <Symbol-To-Java s.sym>) e.rest>;
392  e.accum : v =
393    <Const-Expr-Aux () e.expr> :: (e.arrays) e.j-expr,
394    (e.arrays) ('Expr.fromSequence ("'e.accum'")') e.j-expr;
395  e.expr : t.item e.rest, t.item : {
396    (PAREN e.paren-expr) =
397      <Const-Expr-To-Java e.paren-expr> :: e.arrays (e.j-expr),
398      (e.arrays) ('new Expr ('e.j-expr')');
399    (REF t.name) =
400      () (<Name-To-Java t.name>);
401    (STATIC e) =
402      () (<Rfp2Java t.item>);
403//    (FUNC t.name) =
404//      '.concat (new Expr (new Reference ("'<Name-To-JAVA t.name>'")));
405//       static { Reference.defineReferable('<Rfp2Java e.varName>',
406//             new org.refal.j.Function("") {
407//             public boolean eval(Expr e1, Expr e2) throws Exception {
408//                 return '<Name-To-JAVA t.name>'(e1, e2);
409//             }
410//             });
411//             }//';
412    s.sym, {
413      <Int? s.sym> =
414        () ('new Expr (new '<? &Int>'('s.sym'))');
415      <Word? s.sym> =
416        () ('new Expr ("'<Symbol-To-Java s.sym>'")');
417    };
418  } :: (e.arrays) e.java-item =
419    <Const-Expr-Aux () e.rest> :: (e.new-arrays) e.java-rest,
420    (e.arrays e.new-arrays) e.java-item e.java-rest;
421  = () /*empty*/;
422};
423
424Symbol-To-Java s.ObjectSymbol, {
425  <To-Chars s.ObjectSymbol> () $iter {
426    e.symbol : s.char e.rest, s.char : {
427      '\\' = '\\\\';
428      '\n' = '\\n';
429      '\t' = '\\t';
430//        '\v' = '\\v';
431//        '\b' = '\\b';
432      '\r' = '\\r';
433//        '\f' = '\\f';
434      '\"' = '\\"';
435//      '\'' = '\\\'';
436      s = s.char;
437    } :: e.java-char,
438    e.rest (e.java-symbol e.java-char);
439  } :: e.symbol (e.java-symbol),
440    e.symbol : /*empty*/ =
441    e.java-symbol;
442};
443
444Int-Args-To-Java s.acc e.args =
445  e.args (/*e.java-args*/) $iter {
446    e.args : (e.arg) e.rest =
447      {
448        e.rest : v = ', ';
449        /*empty*/;
450      } :: e.comma,
451      e.rest (e.java-args <Expr-Int-To-Java s.acc e.arg> e.comma);
452    } :: e.args (e.java-args),
453  e.args : /*empty*/ =
454  e.java-args;
455
456Var-Args-To-Java e.args =
457  e.args (/*e.java-args*/) $iter {
458    e.args : t.arg e.rest =
459      {
460        e.rest : v = ', ';
461        /*empty*/;
462      } :: e.comma,
463      e.rest (e.java-args 'Expr '<Rfp2Java t.arg> e.comma);
464    } :: e.args (e.java-args),
465  e.args : /*empty*/ =
466  e.java-args;
467
468Expr-Args-To-Java e.args =
469  e.args (/*e.java-args*/) (/*e.arrays*/) $iter {
470    e.args : (e.arg) e.rest =
471      {
472        e.rest : v = ', ';
473        /*empty*/;
474      } :: e.comma,
475      <Expr-Ref-To-Java e.arg> :: e.a (e.j-arg),
476      e.rest (e.java-args e.j-arg e.comma) (e.arrays e.a);
477  } :: e.args (e.java-args) (e.arrays),
478  e.args : /*empty*/ =
479  e.arrays (e.java-args);
480
481Name-To-Java t.obj-name =
482  <RFP-Extract-Qualifiers t.obj-name> :: (e.qualifiers) e.name,
483  <? &Current-Namespace> :: e.namespace,
484  {
485    e.qualifiers : e.namespace e.cont = <Rfp2Java e.cont e.name>;
486    <Rfp2Java (e.qualifiers e.name)>;
487  };
488
489Access-Mode t.name, {
490  <? &Exports> : e t.name e = 'public';
491  'private';
492};
493
494Free-Index =
495  <? &Free-Idx> : {
496    /*empty*/ = 1;
497    s.idx     = <"+" s.idx 1>;
498  } :: s.idx,
499  <Store &Free-Idx s.idx>,
500  s.idx;
501
Note: See TracBrowser for help on using the repository browser.