source: to-imperative/trunk/compiler/rfp_asail_jbc.rf @ 2346

Last change on this file since 2346 was 2346, checked in by yura, 14 years ago
  • no tabs
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 20.5 KB
Line 
1// $Id: rfp_asail_jbc.rf 2346 2007-02-07 13:57:40Z yura $
2// vim: set et ts=2 sw=2 :
3
4$use Access Apply Arithm Box Class Compare Convert File JavaMangle List StdIO Table Java;
5$use "rfpc";
6$use "rfp_helper";
7
8$import "org.objectweb.asm.ClassWriter";
9$import "org.objectweb.asm.FieldVisitor";
10$import "org.objectweb.asm.Label";
11$import "org.objectweb.asm.MethodVisitor";
12$import "org.objectweb.asm.Opcodes";
13
14$box Int;
15
16$box Exports;
17
18$table Inputs;
19
20$box Module-Name;
21
22$box Entry;
23
24$box Entry-Name;
25
26$box Current-Namespace;
27
28$box Func-Name;
29
30$box Ress;
31$table Result;
32$box Res-Assigns;
33
34$table Iter-Vars;
35
36$func Module-To-JBC s.cw e.module = ;
37
38$func Func-To-JBC s.mv e.body = ;
39
40$func ASAIL-To-JBC e.body = e.java-code;
41
42$func Expr-To-JBC (e.ASAIL-Expr-init ) e.ASAIL-Expr-rest = e.aux-arrays (e.java-expr);
43
44$func Expr-Ref-To-JBC e.ASAIL-Expr-Ref = e.aux-arrays (e.JAVA-Expr-Ref);
45
46$func Expr-Int-To-JBC s.acc e.ASAIL-Expr-Int = e.JAVA-Expr-Int;
47
48$func Step-To-JBC e.step-operators = e.java-step-operators;
49
50$func Const-Expr-To-JBC e.ASAIL-const-expr = e.aux-arrays (e.JAVA-const-expr);
51
52$func Expr-Args-To-JBC e.args = e.aux-arrays (e.java-args);
53
54$func Int-Args-To-JBC s.acc e.args = e.java-args;
55
56$func Var-Args-To-JBC e.args = e.java-args;
57
58$func Symbol-To-JBC s.RFP-Symbol = e.JAVA-String;
59
60$func Name-To-JBC t.name = e.JAVA-Name;
61
62$func Var-To-JBC t.var = e.java-var;
63
64$func Cond-To-JBC s.acc e.cond = e.JAVA-Cond;
65
66$func Infix-To-JBC s.acc s.func-for-converting-args-to-java s.op e.args = e.java-expr;
67
68$func Op-Arg-To-JBC s.op = s.func-for-converting-args-to-java;
69
70$func Access-Mode t.name = s.jbc-access-mode;
71
72$box Free-Idx;
73
74$func Free-Index = e.free-index;
75
76$func Declare-Results (e.ress) e.acc-java-ress = e.decls (e.java-ress);
77
78RFP-ASAIL-To-JBC (e.module-name) (e.package) (e.exports) e.module =
79  <Store &Free-Idx>,
80  <RFP-Clear-Table &Iter-Vars>,
81  <RFP-Clear-Table &Inputs>,
82  {
83    <Store &Int <Lookup &RFP-Options INT>>;
84    <Store &Int BigInteger>;
85  },
86  <Store &Exports e.exports>,
87  <Store &Current-Namespace e.module-name>,
88  {
89    <Store &Entry <Lookup &RFP-Options ENTRIES>>;
90    <Store &Entry (e.module-name Main)>;
91  },
92  <Store &Entry-Name /*empty*/>,
93  <Concat <Map! &To-Word (<Separate (<? &Dir-Separator>) e.package> <Separate ('.') <Rfp2Java e.module-name>>)>>
94  :: e.java-module-name,
95  <Store &Module-Name <Intersperse ('.') e.java-module-name>>,
96  <ClassWriter <"+" &"COMPUTE_MAXS" &"COMPUTE_FRAMES">> :: s.cw,
97  //<ASAIL-To-JBC s.cw e.module> : e,
98  /*{
99    <? &Entry-Name> : v.name =
100      ()
101          ('public static void main (java.lang.String[] args) {' (
102            ('RefalRuntime.setArgs ("'e.java-module-name'", args);')
103      ('try {' (v.name' (new Result ());') '}')
104            ('catch (RefalException e) {' (
105              ('java.lang.System.out.println ("$error: " + e);')
106              ('java.lang.System.exit (100);')
107            )'}')
108          )'}');;
109      } :: e.entry,*/
110  <"visit" s.cw 46 &"ACC_PUBLIC" <To-Word <Intersperse ('/') e.java-module-name>> <Null> "java/lang/Object" ()>,
111  <Module-To-JBC s.cw e.module>,
112  <"visitEnd" s.cw>,
113  <"toByteArray" s.cw> e.java-module-name;
114
115$table Vars;
116$box Var-Idx;
117
118$func Bind-Vars s.type e.vars = ;
119$func Bind-Var s.type t.var = s.i;
120$func Lookup-Var t.var = s.type s.i;
121
122Bind-Vars s.type e.vars =
123  {
124    e.vars : e t.var e,
125      <Bind-Var s.type t.var> : e,
126      $fail;;
127  };
128
129Bind-Var s.type t.var =
130  <? &Var-Idx> : s.i,
131  <Bind &Vars (t.var) (s.type s.i)>,
132  <Store &Var-Idx <"+" s.i 1>>,
133  s.i;
134
135Lookup-Var t.var = <Lookup &Vars t.var> : s.type s.i = s.type s.i;
136
137$table Labels;
138
139$func Bind-Label t.label = s.l;
140$func Lookup-Label t.label = s.l;
141
142Bind-Label t.label =
143  <Label> :: s.l,
144  <Bind &Labels (t.label) (s.l)>,
145  s.l;
146
147Lookup-Label t.label = <Lookup &Labels t.label> : s.l = s.l;
148
149Module-To-JBC s.cw e.module, {
150  e.module : e t.item e, t.item : {
151    (s.tag t.name (e.args) (e.ress) e.body),
152      s.tag : \{
153        FUNC  = 'V';
154        FUNC? = 'Z';
155      } : s.retType,
156      <Clear-Table &Vars>,
157      <Store &Var-Idx 0>,
158      <Bind-Vars Expr e.args>,
159      <Bind-Vars Result e.ress>,
160      <Clear-Table &Labels>,
161      <"+" &"ACC_STATIC" <Access-Mode t.name>> :: s.accessMode,
162      <To-Word <Name-To-JBC t.name>> :: s.funcName,
163      <To-Word '(' <Replicate <Length e.args> "Lorg/refal/plus/Expr;">
164        <Replicate <Length e.ress> "Lorg/refal/plus/Result;">')' s.retType> :: s.desc,
165      <"visitMethod" s.cw s.accessMode s.funcName s.desc <Null> ("org/refal/plus/RefalException")> :: s.mv,
166      <Func-To-JBC s.mv e.body>,
167      s.tag : {
168        FUNC  = <MVvisitInsn s.mv &RETURN>;
169        FUNC? = <MVvisitInsn s.mv &"ICONST_1"> <MVvisitInsn s.mv &IRETURN>;
170      },
171      <MVvisitEnd s.mv>;
172    (CONSTEXPR s.linkage t.name (e.comment) e.expr) =
173      <"+" &"ACC_STATIC" <"+" &"ACC_FINAL" <Access-Mode t.name>>> :: s.accessMode,
174      {
175        t.name : (STATIC e) = <Rfp2Java t.name>;
176        //<RFP-Extract-Qualifiers t.name> :: (e.qualifiers) e.name = e.name;
177        <Name-To-JBC t.name>;
178      } :: e.n,
179      <"visitField" s.cw s.accessMode <To-Word e.n> "Lorg/refal/plus/Expr;" <Null> <Null>> :: s.fv,
180      <FVvisitEnd s.fv>;
181      //<Const-Expr-To-JBC e.expr> :: e.a (e.j-expr),
182      //e.a ('static '<Access-Mode t.name>' final Expr 'e.n' = 'e.j-expr';');
183    (OBJ s.linkage s.tag t.name) =
184      <To-Chars s.tag> : s1 e2,
185      'Named' s1 <To-Lower e2> :: e.class-name,
186      <Bind &Inputs ('org.refal.plus.library.'e.class-name) ()>,
187      <"+" &"ACC_STATIC" <"+" &"ACC_FINAL" <Access-Mode t.name>>> :: s.accessMode,
188      <"visitField" s.cw s.accessMode <To-Word <Name-To-JBC t.name>> "Lorg/refal/plus/Expr;" <Null> <Null>> :: s.fv,
189      <FVvisitEnd s.fv>;
190      //<RFP-Extract-Qualifiers t.name> :: (e.qualifiers) e.n,
191      //('static '<Access-Mode t.name>' final Expr '<Name-To-JBC t.name>
192      //  ' = new Expr (new 'e.class-name' ("'e.n'"));');
193    (DECL-OBJ t.name) = ;
194    (DECL-FUNC t.name) = ;
195    (TRACE t.name) =
196      <Bind &RFP-Trace (t.name) ()>;
197  },
198    $fail;;
199};
200
201Func-To-JBC s.mv e.func-body, {
202  e.func-body : e t.item e, t.item : {
203    (DECL s.type t.var) =
204      <Bind-Var s.type t.var> :: s.i,
205      {
206        s.type : Result =
207          <MVvisitTypeInsn s.mv &NEW "org/refal/plus/Expr">,
208          <MVvisitInsn s.mv &DUP>,
209          <MVvisitMethodInsn s.mv &INVOKESPECIAL "org/refal/plus/Result" "<init>" "()V">,
210          <MVvisitVarInsn s.mv &ASTORE s.i>;
211        <MVvisitFieldInsn s.mv &GETSTATIC "org/refal/plus/Expr" "empty" "Lorg/refal/plus/Expr;">,
212          <MVvisitVarInsn s.mv &ASTORE s.i>;
213      };
214    RETFAIL = <MVvisitInsn s.mv &"ICONST_0"> <MVvisitInsn s.mv &IRETURN>;
215    (IF (e.cond) e.body) =
216      <Box> :: s.acc,
217      <Cond-To-JBC s.acc e.cond> :: e.j-cond,
218      {
219        e.cond : (NOT (CALL e)) =
220          () (<? &Res-Assigns> <Store &Res-Assigns /*empty*/>);
221        (<? &Res-Assigns> <Store &Res-Assigns /*empty*/>) ();
222      } :: (e.if-yes-assigns) (e.if-not-assigns),
223      <? s.acc>
224      ('if ('e.j-cond')')
225      ('{' (
226        e.if-yes-assigns
227        <ASAIL-To-JBC e.body>
228      )'}' )
229      e.if-not-assigns : e;
230    (FOR (e.cont-label) (e.break-label) (e.cond) (e.step) e.body) =
231      {
232        e.cont-label : t.label = <Bind-Label t.label>;
233        <Label>;
234      } :: s.cont-label,
235      {
236        e.break-label : t.label = <Bind-Label t.label>;
237        <Label>;
238      } :: s.break-label,
239      <Label> :: s.for-label,
240      <MVvisitLabel s.mv s.for-label>,
241      //<Cond-To-JBC s.acc e.cond> : e,
242      <MVvisitJumpInsn s.mv &IFEQ s.break-label>,
243      //<ASAIL-To-JBC e.body> : e,
244      <MVvisitLabel s.mv s.cont-label>,
245      //<Step-To-JBC e.step> : e,
246      <MVvisitJumpInsn s.mv &GOTO s.for-label>,
247      <MVvisitLabel s.mv s.break-label>;
248    (LABEL (t.label) e.body) =
249      <Bind-Label t.label> :: s.l,
250      <Func-To-JBC s.mv e.body>,
251      <MVvisitLabel s.mv s.l>;
252    (s.tag t.label), s.tag : \{ CONTINUE; BREAK; } =
253      <MVvisitJumpInsn s.mv &GOTO <Lookup-Label t.label>>;
254    (TRY e.body) =
255      ('try') ('{' (
256        ('if (false)'
257          ('throw new RefalException ("'<? &Module-Name>'", "'<? &Func-Name>'", '
258            '"This is for avoiding \'Unreachable code\' errors");'
259        )   )
260        <ASAIL-To-JBC e.body>
261      ) '}') : e;
262    (CATCH-ERROR e.body) =
263      ('catch (RefalException error) {' (
264        ('Expr err = error.getExpr ();')
265        (<ASAIL-To-JBC e.body>)
266      ) '}') : e;
267    FATAL =
268      ('throw new RefalException ("'<? &Module-Name>'", "'<? &Func-Name>'", "Unexpected fail");') : e;
269    (LSPLIT t.name (e.min) t.var1 t.var2) =
270      <Expr-Ref-To-JBC t.name> :: e.a (e.n),
271      '_va_' <Free-Index> :: e.new-var,
272      <Bind &Iter-Vars (t.name) (e.new-var t.var1 t.var2)>,
273      <Box> :: s.acc,
274      <Expr-Int-To-JBC s.acc e.min> :: e.min,
275      e.a <? s.acc>
276      ('Expr.SplitIterator 'e.new-var' = 'e.n'.leftSplit('e.min');') : e;
277    (RSPLIT t.name (e.min) t.var1 t.var2) =
278      <Expr-Ref-To-JBC t.name> :: e.a (e.n),
279      '_va_' <Free-Index> :: e.new-var,
280      <Bind &Iter-Vars (t.name) (e.new-var t.var1 t.var2)>,
281      <Box> :: s.acc,
282      <Expr-Int-To-JBC s.acc e.min> :: e.min,
283      e.a <? s.acc>
284      ('Expr.SplitIterator 'e.new-var' = 'e.n'.rightSplit('e.min');') : e;
285    (ASSIGN t.var e.expr) =
286      <Expr-To-JBC () e.expr> :: e.a (e.j-expr),
287      {
288        <? &Ress> : e t.var e =
289          e.a (<Rfp2Java t.var>'.assign ('e.j-expr');');
290        e.a (<Lookup &Result t.var>'.assign ('e.j-expr');');
291        e.a (<Rfp2Java t.var>' = 'e.j-expr';');
292      } : e;
293    (INT t.var e.expr) =
294      <Box> :: s.acc,
295      <Expr-Int-To-JBC s.acc e.expr> :: e.expr,
296      <? s.acc> ('int '<Rfp2Java t.var>' = 'e.expr';') : e;
297    (EXPR t.var e.expr) =
298      <Unbind &Result t.var>,
299      <Expr-Ref-To-JBC e.expr> :: e.a (e.j-expr),
300      e.a ('Expr '<Rfp2Java t.var>' = 'e.j-expr';') : e;
301    (DEREF t.var e.expr (e.pos)) =
302      <Unbind &Result t.var>,
303      <Expr-Ref-To-JBC e.expr> :: e.a (e.j-expr),
304      <Box> :: s.acc,
305      <Expr-Int-To-JBC s.acc e.pos> :: e.pos,
306      e.a <? s.acc> ('Expr '<Rfp2Java t.var>' = (Expr) 'e.j-expr'.at ('e.pos');') : e;
307    (SUBEXPR t.var e.expr (e.pos) (e.len)) =
308      <Unbind &Result t.var>,
309      <Expr-Ref-To-JBC e.expr> :: e.a (e.j-expr),
310      <Box> :: s.acc,
311      <Expr-Int-To-JBC s.acc e.pos> :: e.pos,
312      <Expr-Int-To-JBC s.acc e.len> :: e.len,
313      e.a <? s.acc> ('Expr '<Rfp2Java t.var>' = new Expr ('e.j-expr', 'e.pos', 'e.len');') : e;
314    (DROP t.var) =
315      (<Var-To-JBC t.var>'.drop ();') : e;
316    (ERROR e.expr) =
317      <Expr-Ref-To-JBC e.expr> :: e.a (e.j-expr),
318      e.a ('throw new RefalException ('e.j-expr');') : e;
319    /*
320     * s.call can be CALL or TAILCALL or TAILCALL?
321     */
322    (s.call t.name (e.args) (e.ress)) =
323      <Declare-Results (e.ress)> :: e.decls (e.ress),
324      <Expr-Args-To-JBC e.args Result e.ress> :: e.arrays (e.args),
325      <Name-To-JBC t.name>' ('e.args')' :: e.c,
326      {
327        s.call : TAILCALL? =
328          e.arrays e.decls ('if (!'e.c') {' ('return false;') '}');
329        e.arrays e.decls (e.c';') <? &Res-Assigns>
330          <Store &Res-Assigns /*empty*/>;
331      } : e;
332  },
333    $fail;;
334};
335
336ASAIL-To-JBC e = ;
337
338Declare-Results {
339  (t.var e.r) e.ress, {
340    <In-Table? &Result t.var> = <Declare-Results (e.r) e.ress (<Rfp2Java t.var>)>;
341    <? &Ress> : e t.var e     = <Declare-Results (e.r) e.ress (<Rfp2Java t.var>)>;
342    '_va_' <Free-Index> :: e.new-var,
343      <Put &Res-Assigns (<Rfp2Java t.var>' = 'e.new-var'.getExpr ();')> =
344      ('Result 'e.new-var' = new Result ();') <Declare-Results (e.r) e.ress (e.new-var)>;
345  };
346  () e.ress = (e.ress);
347};
348
349/*
350 * Determine type of e.expr - int or Refal.
351 */
352Expr-To-JBC (e.init) e.expr-all, e.expr-all : {
353  /*empty*/ = <Expr-Ref-To-JBC e.init>;
354  (PAREN e.expr) e.rest = <Expr-Ref-To-JBC e.init e.expr-all>;
355  (EXPR e.expr) e.rest = <Expr-Ref-To-JBC e.init e.expr-all>;
356  (DEREF e.expr) e.rest = <Expr-Ref-To-JBC e.init e.expr-all>;
357  (SUBEXPR e.expr) e.rest = <Expr-Ref-To-JBC e.init e.expr-all>;
358  (LENGTH e.expr) e.rest = (<Expr-Int-To-JBC XXX e.init e.expr-all>);
359  (MAX e.args) e.rest = (<Expr-Int-To-JBC XXX e.init e.expr-all>);
360  (MIN e.args) e.rest = (<Expr-Int-To-JBC XXX e.init e.expr-all>);
361  (INFIX s.op e.args) e.rest = (<Expr-Int-To-JBC XXX e.init e.expr-all>);
362  (s.var-tag (e.QualifiedName)) e.rest =
363    <Expr-To-JBC (e.init (s.var-tag (e.QualifiedName))) e.rest>;
364};
365
366$func Term-Ref-To-JBC s.acc term = e.term;
367
368Expr-Ref-To-JBC {
369  /*empty*/ = ('Expr.empty');
370  term =
371    <Box> :: s.acc,
372    <Term-Ref-To-JBC s.acc term> :: e.term,
373    <? s.acc> (e.term);
374  t1 t2 =
375    <Box> :: s.acc,
376    <Term-Ref-To-JBC s.acc t1> :: e.t1,
377    <Term-Ref-To-JBC s.acc t2> :: e.t2,
378    <? s.acc> ('new Expr ('e.t1', 'e.t2')');
379  expr =
380    '_va_'<Free-Index> :: e.new-var,
381    <Box> :: s.acc,
382    <Infix-To-JBC s.acc &Term-Ref-To-JBC "," <Paren expr>> :: e.arr-init,
383    <? s.acc>
384    ('Expr[] 'e.new-var' = { 'e.arr-init' };')
385    ('Expr.concat ('e.new-var')');
386};
387
388Term-Ref-To-JBC s.acc term = term : {
389  (PAREN e.expr) =
390    <Expr-Ref-To-JBC e.expr> :: e.a (e.j-expr),
391    <Put s.acc e.a>,
392    'new Expr('e.j-expr')';
393  (DEREF e.expr (e.pos)) =
394    <Expr-Ref-To-JBC e.expr> :: e.a (e.j-expr),
395    <Put s.acc e.a>,
396    <Expr-Int-To-JBC s.acc e.pos> :: e.pos,
397    '(Expr) 'e.j-expr'.at ('e.pos')';
398  (SUBEXPR e.expr (e.pos) (e.len)) =
399    <Expr-Ref-To-JBC e.expr> :: e.a (e.j-expr),
400    <Put s.acc e.a>,
401    <Expr-Int-To-JBC s.acc e.pos> :: e.pos,
402    <Expr-Int-To-JBC s.acc e.len> :: e.len,
403    'new Expr ('e.j-expr', 'e.pos', 'e.len')';
404  (REF t.name) = <Name-To-JBC t.name>;
405  ERROR-EXPR = 'err';
406  (s.var-tag e.ns t.name) = <Var-To-JBC term>;
407};
408
409Expr-Int-To-JBC s.acc expr = expr : {
410//  /*empty*/ = /*empty*/;
411  s.ObjectSymbol =
412    {
413      <Int? s.ObjectSymbol> = s.ObjectSymbol;
414      $error ("Illegal int-symbol: " s.ObjectSymbol);
415        //FIXME: надо проверять, что число не
416        //       выходит за допустимые границы.
417        //       Задавать эти границы опциями.
418    };
419  (LENGTH e.expr) =
420    <Expr-Ref-To-JBC e.expr> :: e.a (e.j-expr),
421    <Put s.acc e.a>,
422    e.j-expr'.getLen ()';
423  (MAX e.args) =
424    'java.lang.Math.max ('<Int-Args-To-JBC s.acc e.args>')';
425  (MIN e.args) =
426    'java.lang.Math.min ('<Int-Args-To-JBC s.acc e.args>')';
427  (INFIX s.op e.args) =
428    '(' <Infix-To-JBC s.acc &Expr-Int-To-JBC s.op e.args> ')';
429//  (REF t.name) = <Name-To-JBC t.name>;
430  (s.var-tag t.name) = <Rfp2Java (s.var-tag t.name)>;
431  expr = '(' <Infix-To-JBC s.acc &Expr-Int-To-JBC "+" <Paren expr>> ')';
432};
433
434Cond-To-JBC s.acc expr = expr : {
435  /*empty*/ = /*empty*/;
436  (CALL t.name (e.args) (e.ress)) =
437    <Declare-Results (e.ress)> :: e.decls (e.ress),
438    <Expr-Args-To-JBC e.args Result e.ress> :: e.arrays (e.args),
439    <Put s.acc e.arrays e.decls>,
440    <Name-To-JBC t.name>' ('e.args')';
441  (SYMBOL? e.expr (e.pos)) =
442    <Expr-Ref-To-JBC e.expr> :: e.a (e.j-expr),
443    <Put s.acc e.a>,
444    e.j-expr'.symbolAt ('<Expr-Int-To-JBC s.acc e.pos>')';
445  (CHECK-ITER e.expr) =
446    <Middle 0 2 <Lookup &Iter-Vars e.expr>>'.isValid ()';
447  (EQ e.expr1 (e.expr2) (e.pos)) =
448    <Expr-Ref-To-JBC e.expr1> :: e.a1 (e.j-expr1),
449    <Expr-Ref-To-JBC e.expr2> :: e.a2 (e.j-expr2),
450    <Put s.acc e.a1 e.a2>,
451    e.j-expr1'.eq ('e.j-expr2', '<Expr-Int-To-JBC s.acc e.pos>')';
452  (TERM-EQ e.expr1 (e.expr2) (e.pos)) =
453    <Expr-Ref-To-JBC e.expr1> :: e.a1 (e.j-expr1),
454    <Expr-Ref-To-JBC e.expr2> :: e.a2 (e.j-expr2),
455    <Put s.acc e.a1 e.a2>,
456    e.j-expr1'.eq ('e.j-expr2', '<Expr-Int-To-JBC s.acc e.pos> ')';
457  (NOT e.cond) =
458    '!' <Cond-To-JBC s.acc e.cond>;
459  (INFIX s.op e.args) =
460    {
461      s.op : \{ "+"; "-"; "%"; "*"; "/"; } =
462        <Infix-To-JBC s.acc &Expr-Int-To-JBC s.op e.args>' != 0';
463      '(' <Infix-To-JBC s.acc <Op-Arg-To-JBC s.op> s.op e.args> ')';
464    };
465  expr = '(' <Infix-To-JBC s.acc &Cond-To-JBC "&&" <Paren expr>> ')';
466};
467
468Infix-To-JBC s.acc s.arg2java s.op e.args, {
469  e.args : (e.arg) e.rest =
470    <Apply s.arg2java s.acc e.arg> :: e.arg,
471    <Infix-To-JBC s.acc s.arg2java s.op e.rest> :: e.rest,
472    {
473      e.arg : v, e.rest : v = e.arg ' ' s.op ' ' e.rest;
474      e.arg e.rest;
475    };;
476};
477
478Op-Arg-To-JBC s.op, {
479  s.op : \{ "&&"; "||"; } =
480    &Cond-To-JBC;
481  s.op : \{ "<"; ">"; "<="; ">="; "=="; "!="; "+"; "-"; "%"; "*"; "/"; } =
482    &Expr-Int-To-JBC;
483};
484 
485Step-To-JBC {
486  /*empty*/ = /*empty*/;
487  (INC-ITER e.expr) = <Middle 0 2 <Lookup &Iter-Vars e.expr>>'.next ()';
488  (DEC-ITER e.expr) = <Middle 0 2 <Lookup &Iter-Vars e.expr>>'.prev ()';
489};
490
491$func Const-Expr-Aux (e.accum) e.expr = (e.arrays) e.java-expr;
492
493Const-Expr-To-JBC {
494  /*empty*/ = ('Expr.empty');
495  (SUBEXPR t.name s.pos s.len) = ('new Expr ('<Rfp2Java t.name>', 's.pos', 's.len')');
496                  //FIXME: надо проверять, что s.pos и s.len
497                  //       не превышают допустимых величин.
498                  //       Задавать эти величины опциями.
499  e.expr =
500    <Const-Expr-Aux () e.expr> : {
501      (e.arrays) (e1)      = e.arrays (e1);
502      (e.arrays) (e1) (e2) = e.arrays ('new Expr ('e1', 'e2')');
503      (e.arrays) e.concat  =
504        '_va_'<Free-Index> :: e.new-var,
505        e.arrays
506        ('static private final Expr[] 'e.new-var' = { '<Concat <Intersperse (', ') e.concat>>' };')
507        ('Expr.concat ('e.new-var')');
508    };
509};
510
511Const-Expr-Aux (e.accum) e.expr, {
512  e.expr : s.sym e.rest, <Char? s.sym> =
513    <Const-Expr-Aux (e.accum <Symbol-To-JBC s.sym>) e.rest>;
514  e.accum : v =
515    <Const-Expr-Aux () e.expr> :: (e.arrays) e.j-expr,
516    (e.arrays) ('Expr.fromSequence ("'e.accum'")') e.j-expr;
517  e.expr : t.item e.rest, t.item : {
518    (PAREN e.paren-expr) =
519      <Const-Expr-To-JBC e.paren-expr> :: e.arrays (e.j-expr),
520      (e.arrays) ('new Expr ('e.j-expr')');
521    (REF t.name) =
522      () (<Name-To-JBC t.name>);
523    (STATIC e) =
524      () (<Rfp2Java t.item>);
525    (FUNC? t.name) = () ('new Expr (new Func () {'
526      ('public boolean eval (Expr arg, Result res) throws RefalException {'
527        ('return '<Name-To-JBC t.name>' (arg, res);')
528      '}') '})');
529    (FUNC t.name) = () ('new Expr (new Func () {'
530      ('public boolean eval (Expr arg, Result res) throws RefalException {'
531        ((<Name-To-JBC t.name>' (arg, res);')
532         ('return true;'))
533      '}') '})');
534    s.sym, {
535      <Int? s.sym> =
536        {
537          <? &Int> : BigInteger =
538            <Bind &Inputs ('java.math.BigInteger') ()>;;
539        },
540        () ('new Expr (new '<? &Int>' ("'s.sym'"))');
541      <Word? s.sym> =
542        () ('new Expr (new Word ("'<Symbol-To-JBC s.sym>'"))');
543    };
544  } :: (e.arrays) e.java-item =
545    <Const-Expr-Aux () e.rest> :: (e.new-arrays) e.java-rest,
546    (e.arrays e.new-arrays) e.java-item e.java-rest;
547  = () /*empty*/;
548};
549
550Symbol-To-JBC s.ObjectSymbol, {
551  <To-Chars s.ObjectSymbol> () $iter {
552    e.symbol : s.char e.rest, s.char : {
553      '\\' = '\\\\';
554      '\n' = '\\n';
555      '\t' = '\\t';
556//        '\v' = '\\v';
557//        '\b' = '\\b';
558      '\r' = '\\r';
559//        '\f' = '\\f';
560      '\"' = '\\"';
561//      '\'' = '\\\'';
562      s = s.char;
563    } :: e.java-char,
564    e.rest (e.java-symbol e.java-char);
565  } :: e.symbol (e.java-symbol),
566    e.symbol : /*empty*/ =
567    e.java-symbol;
568};
569
570Int-Args-To-JBC s.acc e.args =
571  e.args (/*e.java-args*/) $iter {
572    e.args : (e.arg) e.rest =
573      {
574        e.rest : v = ', ';
575        /*empty*/;
576      } :: e.comma,
577      e.rest (e.java-args <Expr-Int-To-JBC s.acc e.arg> e.comma);
578    } :: e.args (e.java-args),
579  e.args : /*empty*/ =
580  e.java-args;
581
582Var-Args-To-JBC e.args =
583  e.args (/*e.type*/) (/*e.java-args*/) $iter {
584    e.args : s.t e.rest =
585      e.rest (s.t) (e.java-args);
586    e.args : t.arg e.rest =
587      {
588        e.rest : e (e) e = ', ';
589        /*empty*/;
590      } :: e.comma,
591      e.rest (e.type) (e.java-args e.type' '<Rfp2Java t.arg> e.comma);
592    } :: e.args (e.type) (e.java-args),
593  e.args : /*empty*/ =
594  e.java-args;
595
596Expr-Args-To-JBC e.args =
597  e.args (/*e.type*/) (/*e.java-args*/) (/*e.arrays*/) $iter {
598    e.args : s.t e.rest =
599      e.rest (s.t) (e.java-args) (e.arrays);
600    e.args : (e.arg) e.rest =
601      {
602        e.rest : e (e) e = ', ';
603        /*empty*/;
604      } :: e.comma,
605      {
606        e.type : /*empty*/ =
607          <Expr-Ref-To-JBC e.arg> :: e.a (e.j-arg),
608          e.rest (e.type) (e.java-args e.j-arg e.comma) (e.arrays e.a);
609        e.rest (e.type) (e.java-args e.arg e.comma) (e.arrays);
610      };
611  } :: e.args (e.type) (e.java-args) (e.arrays),
612  e.args : /*empty*/ =
613  e.arrays (e.java-args);
614
615Name-To-JBC t.obj-name =
616  <RFP-Extract-Qualifiers t.obj-name> :: (e.qualifiers) e.name,
617  <? &Current-Namespace> :: e.namespace,
618  {
619    e.qualifiers : e.namespace e.cont = <Rfp2Java e.cont e.name>;
620    <Bind &Inputs (e.qualifiers) ()>,
621      <Rfp2Java (e.qualifiers e.name)>;
622  };
623
624Var-To-JBC t.var = {
625  <Lookup &Result t.var>'.getExpr ()';
626  <Rfp2Java t.var>;
627};
628
629Access-Mode t.name, {
630  <? &Exports> : e t.name e = &"ACC_PUBLIC";
631  0;
632};
633
634Free-Index =
635  <? &Free-Idx> : {
636    /*empty*/ = 1;
637    s.idx     = <"+" s.idx 1>;
638  } :: s.idx,
639  <Store &Free-Idx s.idx>,
640  s.idx;
641
Note: See TracBrowser for help on using the repository browser.