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

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