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

Last change on this file since 2488 was 2488, checked in by orlov, 14 years ago
  • ASAIL simplifications: no INT, no EXPR, int-vars contain type-tag INT.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 28.3 KB
Line 
1// $Id: rfp_asail_jbc.rf 2488 2007-02-27 18:34:33Z 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 Module-Name;
16$box Refal-Module-Name;
17$box Class-Name;
18
19$box Entry;
20$box Entry-Name;
21
22$box Func-Name;
23
24$func Module-To-JBC s.cw e.module = ;
25
26$func ASAIL-To-JBC e.body = ;
27
28$func Expr-Ref-To-JBC e.ASAIL-Expr-Ref = ;
29
30$func Expr-Int-To-JBC e.ASAIL-Expr-Int = ;
31
32$func Step-To-JBC e.step-operators = ;
33
34$func Const-Expr-To-JBC e.ASAIL-const-expr = ;
35
36$func Var-To-JBC t.var = ;
37
38$func Cond-To-JBC t.cond = s.if;
39
40$func Infix-To-JBC s.func-for-converting-args-to-java s.op e.args = ;
41
42$func Access-Mode s.linkage = s.jbc-access-mode;
43
44$box Objects;
45$box Constants;
46$box Func-Refs;
47
48$func GetJavaName e.name = e.javaName;
49
50GetJavaName e.name = <Concat <Map! &To-Word (<Map! &Rfp2Java (<Paren e.name>)>)>>;
51
52$func GetJBCName t.name = s.jbcName;
53
54GetJBCName t.name = <To-Word <GetJavaName t.name>>;
55
56$func GetJBCQName e.moduleName t.name = s.jbcModuleName s.jbcName;
57
58GetJBCQName e.moduleName t.name = {
59    e.moduleName : "refal" "plus" s.module = "org" "refal" "plus" "library" s.module;
60    e.moduleName;
61  } :: e.moduleName,
62  <GetJavaName e.moduleName t.name> : e.javaModuleName s.javaName,
63  <To-Word <Intersperse ('/') e.javaModuleName>> s.javaName;
64
65$box MVbox;
66
67$func MV = s;
68
69MV, <? &MVbox> : s.mv = s.mv;
70
71RFP-ASAIL-To-JBC (MODULE (e.moduleName) e.module) =
72  <Store &Objects>,
73  <Store &Constants>,
74  <Store &Func-Refs>,
75  {
76    <Store &Entry <Lookup &RFP-Options ENTRIES>>;
77    <Store &Entry (e.moduleName Main)>;
78  },
79  <Store &Entry-Name /*empty*/>,
80  <Store &Module-Name e.moduleName>,
81  <To-Word <Intersperse ('.') e.moduleName>> :: s.refal-mod-name,
82  <Store &Refal-Module-Name s.refal-mod-name>,
83  <GetJavaName e.moduleName> :: e.java-module-name,
84  <To-Word <Intersperse ('/') e.java-module-name>> :: s.class-name,
85  <Store &Class-Name s.class-name>,
86  <ClassWriter &"COMPUTE_MAXS"> :: s.cw,
87  <CWvisit s.cw &"V1_4" &"ACC_PUBLIC" s.class-name <Null> "java/lang/Object" ()>,
88  <Module-To-JBC s.cw e.module>,
89  {
90    <? &Entry-Name> : s.name =
91      /*<ASAIL-To-JBC-Temp s.cw e.module> : e,
92      ()
93          ('public static void main (java.lang.String[] args) {' (
94            ('RefalRuntime.setArgs ("'e.java-module-name'", args);')
95      ('try {' (v.name' (new Result ());') '}')
96            ('catch (RefalException e) {' (
97              ('java.lang.System.out.println ("$error: " + e);')
98              ('java.lang.System.exit (100);')
99            )'}')
100          )'}');;
101      } :: e.entry,*/
102      <Store &MVbox <CWvisitMethod s.cw <"+" &"ACC_PUBLIC" &"ACC_STATIC"> "main" "([Ljava/lang/String;)V" <Null> ()>>,
103      <MVvisitLdcInsn <MV> <WordToString s.refal-mod-name>>,
104      <MVvisitVarInsn <MV> &ALOAD 0>,
105      <MVvisitMethodInsn <MV> &INVOKESTATIC "org/refal/plus/RefalRuntime" "setArgs" "(Ljava/lang/String;[Ljava/lang/String;)V">,
106      <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Result">,
107      <MVvisitInsn <MV> &DUP>,
108      <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Result" "<init>" "()V">,
109      <MVvisitMethodInsn <MV> &INVOKESTATIC s.class-name s.name "(Lorg/refal/plus/Result;)V">,
110      <MVvisitInsn <MV> &RETURN>,
111      <MVvisitMaxs <MV> 0 0>,
112      <MVvisitEnd <MV>>;;
113  },
114  <Store &MVbox <CWvisitMethod s.cw &"ACC_STATIC" "<clinit>" "()V" <Null> ()>>,
115  {
116    <? &Objects> : e (s.j-name s.rf-name e.cl-name) e,
117      <To-Word "org/refal/plus/library/" e.cl-name> :: s.cl-name,
118      <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Expr">,
119      <MVvisitInsn <MV> &DUP>,
120      <MVvisitTypeInsn <MV> &NEW s.cl-name>,
121      <MVvisitInsn <MV> &DUP>,
122      <MVvisitLdcInsn <MV> <WordToString s.rf-name>>,
123      <MVvisitMethodInsn <MV> &INVOKESPECIAL s.cl-name "<init>" "(Ljava/lang/String;)V">,
124      <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Expr" "<init>" "(Ljava/lang/Object;)V">,
125      <MVvisitFieldInsn <MV> &PUTSTATIC s.class-name s.j-name "Lorg/refal/plus/Expr;">,
126      $fail;;
127  },
128  {
129    <? &Constants> : e (s.const-name e.expr) e,
130      <Const-Expr-To-JBC e.expr>,
131      <MVvisitFieldInsn <MV> &PUTSTATIC s.class-name s.const-name "Lorg/refal/plus/Expr;">,
132      $fail;;
133  },
134  <MVvisitInsn <MV> &RETURN>,
135  <MVvisitMaxs <MV> 0 0>,
136  <MVvisitEnd <MV>>,
137  //{
138  //  <? &Func-Refs> : e (s.cl-name s.mod-name s.func-name) e,
139  //    <CWvisitInnerClass s.cw s.cl-name <Null> <Null> &"ACC_STATIC">,
140  //    $fail;;
141  //},
142  <CWvisitEnd s.cw>,
143  <Box (<CWtoByteArray s.cw> e.java-module-name)> :: s.res,
144  {
145    <? &Func-Refs> : e (s.cl-name s.mod-name s.func-name s.type) e,
146      <ClassWriter &"COMPUTE_MAXS"> :: s.cw,
147      <CWvisit s.cw &"V1_4" &"ACC_FINAL" <To-Word s.class-name '$' s.cl-name> <Null> "java/lang/Object" ("org/refal/plus/Func")>,
148      <CWvisitMethod s.cw 0 "<init>" "()V" <Null> ()> :: s.mv,
149      <MVvisitVarInsn s.mv &ALOAD 0>,
150      <MVvisitMethodInsn s.mv &INVOKESPECIAL "java/lang/Object" "<init>" "()V">,
151      <MVvisitInsn s.mv &RETURN>,
152      <MVvisitMaxs s.mv 0 0>,
153      <MVvisitEnd s.mv>,
154      <CWvisitMethod s.cw &"ACC_PUBLIC" "eval" "(Lorg/refal/plus/Expr;Lorg/refal/plus/Result;)Z" <Null> ("org/refal/plus/RefalException")> :: s.mv,
155      <MVvisitVarInsn s.mv &ALOAD 1>,
156      <MVvisitVarInsn s.mv &ALOAD 2>,
157      s.type : {
158        FUNC? =
159          <MVvisitMethodInsn s.mv &INVOKESTATIC s.mod-name s.func-name "(Lorg/refal/plus/Expr;Lorg/refal/plus/Result;)Z">,
160          <MVvisitInsn s.mv &IRETURN>;
161        FUNC  =
162          <MVvisitMethodInsn s.mv &INVOKESTATIC s.mod-name s.func-name "(Lorg/refal/plus/Expr;Lorg/refal/plus/Result;)V">,
163          <MVvisitInsn s.mv &"ICONST_1"> <MVvisitInsn s.mv &IRETURN>;
164      },
165      <MVvisitMaxs s.mv 0 0>,
166      <MVvisitEnd s.mv>,
167      <CWvisitEnd s.cw>,
168      <Put s.res (<CWtoByteArray s.cw>
169        <Middle 0 1 e.java-module-name> <To-Word <R 0 e.java-module-name> '$' s.cl-name>)>,
170      $fail;;
171  },
172  <? s.res>;
173
174$box Block-Tables;
175
176$func Init-Block-Table = ;
177$func Push-Block-Table = ;
178$func Pop-Block-Table = ;
179$func Get-Block-Table = s.block-table;
180
181Init-Block-Table =
182  <Table> :: s.block-table,
183  <Bind s.block-table (VAR-INDEX) (0)>,
184  <Store &Block-Tables s.block-table>;
185
186Push-Block-Table =
187  <? &Block-Tables> : e.block-tables,
188  e.block-tables : e s.block-table,
189  <Store &Block-Tables e.block-tables <Table-Copy s.block-table>>;
190
191Pop-Block-Table =
192  <? &Block-Tables> : e.block-tables s.block-table1 s.block-table2,
193  <Lookup s.block-table2 VAR-INDEX> : s.i,
194  <Bind s.block-table1 (VAR-INDEX) (s.i)>,
195  <Store &Block-Tables e.block-tables s.block-table1>;
196
197Get-Block-Table =
198  <? &Block-Tables> : e s.block-table,
199  s.block-table;
200
201$func Bind-Vars s.type e.vars = ;
202$func Bind-Var s.type t.var = s.i;
203$func Lookup-Var t.var = s.type s.i;
204$func Bind-Iter-Var e.expr t.var1 t.var2 = s.i;
205$func Lookup-Iter-Var e.expr = s.i s.i1 s.i2;
206$func Bind-TMP-Var t.var = s.i;
207$func Lookup-TMP-Var t.var = s.i;
208
209Bind-Vars s.type e.vars =
210  {
211    e.vars : e t.var e,
212      <Bind-Var s.type t.var> : e,
213      $fail;;
214  };
215
216Bind-Var s.type t.var =
217  <Lookup <Get-Block-Table> VAR-INDEX> : s.i,
218  <Bind <Get-Block-Table> (VAR-INDEX) (<"+" s.i 1>)>,
219  <Bind <Get-Block-Table> (VAR t.var) (s.type s.i)>,
220  s.i;
221
222Lookup-Var t.var = <Lookup <Get-Block-Table> VAR t.var> : s.type s.i = s.type s.i;
223
224Bind-Iter-Var e.expr t.var1 t.var2 =
225  <Lookup <Get-Block-Table> VAR-INDEX> : s.i,
226  <Bind <Get-Block-Table> (VAR-INDEX) (<"+" s.i 1>)>,
227  <Bind-Var Expr t.var1> :: s.i1,
228  <Bind-Var Expr t.var2> :: s.i2,
229  <Bind <Get-Block-Table> (ITER e.expr) (s.i s.i1 s.i2)>,
230  s.i;
231
232Lookup-Iter-Var e.expr = <Lookup <Get-Block-Table> ITER e.expr> : s.i s.i1 s.i2 = s.i s.i1 s.i2;
233
234Bind-TMP-Var t.var =
235  <Lookup <Get-Block-Table> VAR-INDEX> : s.i,
236  <Bind <Get-Block-Table> (VAR-INDEX) (<"+" s.i 1>)>,
237  <Bind <Get-Block-Table> (TMP t.var) (s.i)>,
238  s.i;
239
240Lookup-TMP-Var t.var = <Lookup <Get-Block-Table> TMP t.var> : s.i = s.i;
241
242$func Bind-Label t.label = s.l;
243$func Lookup-Label t.label = s.l;
244
245Bind-Label t.label =
246  <Label> :: s.l,
247  <Bind <Get-Block-Table> (LABEL t.label) (s.l)>,
248  s.l;
249
250Lookup-Label t.label = <Lookup <Get-Block-Table> LABEL t.label> : s.l = s.l;
251
252
253$box Traps;
254
255$func Push-Trap s.end s.handler = ;
256$func Get-Trap = s.handler;
257$func Pop-Trap = s.end;
258
259Push-Trap s.end s.handler =
260  <Put &Traps s.end s.handler>;
261
262Get-Trap = <R 0 <? &Traps>> : s.handler = s.handler;
263
264Pop-Trap =
265  <? &Traps> : e.traps s.end s,
266  <Store &Traps e.traps>,
267  s.end;
268
269
270
271$func Function-Description (e.args) (e.ress) s.retType = s.desc;
272
273Function-Description (e.args) (e.ress) s.retType =
274  <To-Word '(' <Replicate <Length e.args> "Lorg/refal/plus/Expr;">
275    <Replicate <Length e.ress> "Lorg/refal/plus/Result;">')' s.retType>;
276
277Module-To-JBC s.cw e.module, {
278  e.module : e t.item e, t.item : {
279    (s.tag IMPORT e) = /*empty*/;
280    (s.tag s.linkage t.name (e.args) (e.ress) e.body),
281      s.tag : \{
282        FUNC  = 'V';
283        FUNC? = 'Z';
284      } : s.retType =
285      <Init-Block-Table>,
286      <Bind-Vars Expr e.args>,
287      <Bind-Vars Result e.ress>,
288      <"+" &"ACC_STATIC" <Access-Mode s.linkage>> :: s.accessMode,
289      t.name : (e s.funcName),
290      <Store &Func-Name s.funcName>,
291      <GetJBCName s.funcName> :: s.funcName,
292      { <? &Entry> : e t.name e = <Store &Entry-Name s.funcName>;; },
293      <Function-Description (e.args) (e.ress) s.retType> :: s.desc,
294      <Store &MVbox <CWvisitMethod s.cw s.accessMode s.funcName s.desc <Null> ("org/refal/plus/RefalException")>>,
295      <ASAIL-To-JBC e.body>,
296      s.tag : {
297        FUNC  = <MVvisitInsn <MV> &RETURN>;
298        FUNC? = <MVvisitInsn <MV> &"ICONST_1"> <MVvisitInsn <MV> &IRETURN>;
299      },
300      <MVvisitMaxs <MV> 0 0>,
301      <MVvisitEnd <MV>>;
302    (CONSTEXPR s.linkage t.name (e.comment) e.expr) =
303      t.name : {
304        (STATIC (e)) = t.name;
305        (e s.const-name) = s.const-name;
306      } :: t.name,
307      <GetJBCName t.name> :: s.name,
308      <"+" &"ACC_STATIC" <"+" &"ACC_FINAL" <Access-Mode s.linkage>>> :: s.accessMode,
309      <CWvisitField s.cw s.accessMode s.name "Lorg/refal/plus/Expr;" <Null> <Null>> :: s.fv,
310      <FVvisitEnd s.fv>,
311      <Put &Constants (s.name e.expr)>;
312    (OBJ s.linkage s.tag t.name) =
313      t.name : (e s.obj-name),
314      <To-Chars s.tag> : s1 e2,
315      'Named' s1 <To-Lower e2> :: e.class-name,
316      <GetJBCName s.obj-name> :: s.n,
317      <"+" &"ACC_STATIC" <"+" &"ACC_FINAL" <Access-Mode s.linkage>>> :: s.accessMode,
318      <CWvisitField s.cw s.accessMode s.n "Lorg/refal/plus/Expr;" <Null> <Null>> :: s.fv,
319      <FVvisitEnd s.fv>,
320      <Put &Objects (s.n s.obj-name e.class-name)>;
321    (DECL-OBJ t.name) = ;
322    (DECL-FUNC t.name) = ;
323    (TRACE t.name) =
324      <Bind &RFP-Trace (t.name) ()>;
325  },
326    $fail;;
327};
328
329ASAIL-To-JBC {
330  e t.item e, /*<WriteLN> <WriteLN t.item>*/ t.item : {
331    (DECL (INT t.var)) =
332      <Bind-Var Int t.var> :: s;
333    (DECL s.type t.var) =
334      <Bind-Var s.type t.var> :: s.i,
335      s.type : {
336        Result =
337          <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Result">,
338          <MVvisitInsn <MV> &DUP>,
339          <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Result" "<init>" "()V">,
340          <MVvisitVarInsn <MV> &ASTORE s.i>;
341        Expr =
342          <MVvisitFieldInsn <MV> &GETSTATIC "org/refal/plus/Expr" "empty" "Lorg/refal/plus/Expr;">,
343          <MVvisitVarInsn <MV> &ASTORE s.i>;
344      };
345    (ASSIGN (INT t.var) e.expr) =
346      <Lookup-Var t.var> :: s s.i,
347      <Expr-Int-To-JBC e.expr>,
348      <MVvisitVarInsn <MV> &ISTORE s.i>;
349    (ASSIGN t.var e.expr) =
350      <Lookup-Var t.var> :: s.type s.i,
351      s.type : {
352        Result =
353          <MVvisitVarInsn <MV> &ALOAD s.i>,
354          <Expr-Ref-To-JBC e.expr>,
355          <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Result" "assign" "(Lorg/refal/plus/Expr;)V">;
356        Expr =
357          <Expr-Ref-To-JBC e.expr>,
358          <MVvisitVarInsn <MV> &ASTORE s.i>;
359      };
360    (IF-INT-CMP s.op (e.arg1) (e.arg2) e.body) =
361      <Push-Block-Table>,
362      <Label> :: s.label,
363      <Expr-Int-To-JBC e.arg1>,
364      <Expr-Int-To-JBC e.arg2>,
365      s.op : {
366        "!=" = &"IF_ICMPEQ";
367        "<" = &"IF_ICMPGE";
368        ">" = &"IF_ICMPLE";
369      } :: s.op,
370      <MVvisitJumpInsn <MV> s.op s.label>,
371      <ASAIL-To-JBC e.body>,
372      <MVvisitLabel <MV> s.label>,
373      <Pop-Block-Table>;
374    (IF t.cond e.body) =
375      <Push-Block-Table>,
376      <Label> :: s.label,
377      <Cond-To-JBC t.cond> :: s.if,
378      <MVvisitJumpInsn <MV> s.if s.label>,
379      <ASAIL-To-JBC e.body>,
380      <MVvisitLabel <MV> s.label>,
381      <Pop-Block-Table>;
382    (LSPLIT t.name (e.min) t.var1 t.var2) =
383      <Push-Block-Table>,
384      <Bind-Iter-Var t.name t.var1 t.var2> :: s.i,
385      <Expr-Ref-To-JBC t.name>,
386      <Expr-Int-To-JBC e.min>,
387      <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Expr" "leftSplit" "(I)Lorg/refal/plus/Expr$SplitIterator;">,
388      <MVvisitVarInsn <MV> &ASTORE s.i>;
389    (RSPLIT t.name (e.min) t.var1 t.var2) =
390      <Push-Block-Table>,
391      <Bind-Iter-Var t.name t.var1 t.var2> :: s.i,
392      <Expr-Ref-To-JBC t.name>,
393      <Expr-Int-To-JBC e.min>,
394      <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Expr" "rightSplit" "(I)Lorg/refal/plus/Expr$SplitIterator;">,
395      <MVvisitVarInsn <MV> &ASTORE s.i>;
396    (FOR (e.cont-label) (e.break-label) () (e.step) e.body) =
397      { e.step : /*empty*/, <Push-Block-Table>;; },
398      {
399        e.cont-label : t.label = <Bind-Label t.label>;
400        <Label>;
401      } :: s.cont-label,
402      {
403        e.break-label : t.label = <Bind-Label t.label>;
404        <Label>;
405      } :: s.break-label,
406      <Label> :: s.for-label,
407      <MVvisitLabel <MV> s.for-label>,
408      {
409        e.step : (s.tag e.expr), s.tag : \{ INC-ITER; DEC-ITER; } =
410          <Lookup-Iter-Var e.expr> : s.i s.i1 s.i2,
411          <MVvisitVarInsn <MV> &ALOAD s.i>,
412          <MVvisitInsn <MV> &DUP>,
413          <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Expr$SplitIterator" "getLeft" "()Lorg/refal/plus/Expr;">,
414          <MVvisitVarInsn <MV> &ASTORE s.i1>,
415          <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Expr$SplitIterator" "getRight" "()Lorg/refal/plus/Expr;">,
416          <MVvisitVarInsn <MV> &ASTORE s.i2>;;
417      },
418      <ASAIL-To-JBC e.body>,
419      <MVvisitLabel <MV> s.cont-label>,
420      <Step-To-JBC e.step>,
421      <MVvisitJumpInsn <MV> &GOTO s.for-label>,
422      <MVvisitLabel <MV> s.break-label>,
423      <Pop-Block-Table>;
424    (LABEL (t.label) e.body) =
425      <Push-Block-Table>,
426      <Bind-Label t.label> :: s.l,
427      <ASAIL-To-JBC e.body>,
428      <MVvisitLabel <MV> s.l>,
429      <Pop-Block-Table>;
430    (s.tag t.label), s.tag : \{ CONTINUE; BREAK; } =
431      <MVvisitJumpInsn <MV> &GOTO <Lookup-Label t.label>>;
432    RETFAIL =
433      <MVvisitInsn <MV> &"ICONST_0"> <MVvisitInsn <MV> &IRETURN>;
434    (TRY e.body) =
435      <Push-Block-Table>,
436      <Label> :: s.start,
437      <Label> :: s.end,
438      <Label> :: s.real-end,
439      <Label> :: s.handler,
440      <Push-Trap s.real-end s.handler>,
441      <MVvisitTryCatchBlock <MV> s.start s.end s.handler "org/refal/plus/RefalException">,
442      <MVvisitLabel <MV> s.start>,
443      <ASAIL-To-JBC e.body>,
444      <MVvisitLabel <MV> s.end>,
445      <MVvisitJumpInsn <MV> &GOTO s.real-end>,
446      <Pop-Block-Table>;
447    (CATCH-ERROR e.body) =
448      <Push-Block-Table>,
449      <Get-Trap> :: s.label,
450      <MVvisitLabel <MV> s.label>,
451      <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/RefalException" "getExpr" "()Lorg/refal/plus/Expr;">,
452      <MVvisitVarInsn <MV> &ASTORE <Bind-Var Expr s.label>>,
453      <ASAIL-To-JBC e.body>,
454      <MVvisitLabel <MV> <Pop-Trap>>,
455      <Pop-Block-Table>;
456    FATAL =
457      <MVvisitTypeInsn <MV> &NEW "org/refal/plus/RefalException">,
458      <MVvisitInsn <MV> &DUP>,
459      <? &Refal-Module-Name> : s.mod-name,
460      <MVvisitLdcInsn <MV> <WordToString s.mod-name>>,
461      <? &Func-Name> : s.fname,
462      <MVvisitLdcInsn <MV> <WordToString s.fname>>,
463      <MVvisitLdcInsn <MV> <WordToString "Unexpected fail">>,
464      <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/RefalException" "<init>" "(Ljava/lang/String;Ljava/lang/String;Ljava/lang/String;)V">,
465      <MVvisitInsn <MV> &ATHROW>;
466    (ERROR e.expr) =
467      <MVvisitTypeInsn <MV> &NEW "org/refal/plus/RefalException">,
468      <MVvisitInsn <MV> &DUP>,
469      <Expr-Ref-To-JBC e.expr>,
470      <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/RefalException" "<init>" "(Lorg/refal/plus/Expr;)V">,
471      <MVvisitInsn <MV> &ATHROW>;
472    (s.call (e.module s.name) (e.args) (e.ress)),
473      s.call : \{ CALL = V; TAILCALL = V; TAILCALL? = Z; } :: s.retType =
474      <Function-Description (e.args) (e.ress) s.retType> :: s.desc,
475      {
476        e.args : e (e.arg) e,
477          <Expr-Ref-To-JBC e.arg>,
478          $fail;;
479      },
480      {
481        e.ress : e t.var e, <Lookup-Var t.var> :
482          {
483            Expr s =
484              <Bind-TMP-Var t.var> :: s.j,
485              <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Result">,
486              <MVvisitInsn <MV> &DUP>,
487              <MVvisitInsn <MV> &DUP>,
488              <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Result" "<init>" "()V">,
489              <MVvisitVarInsn <MV> &ASTORE s.j>;
490            Result s.i =
491              <MVvisitVarInsn <MV> &ALOAD s.i>;
492          }, $fail;;
493      },
494      <MVvisitMethodInsn <MV> &INVOKESTATIC <GetJBCQName e.module s.name> s.desc>,
495      {
496        s.call : TAILCALL? =
497          <Label> :: s.label,
498          <MVvisitJumpInsn <MV> &IFNE s.label>,
499          <MVvisitInsn <MV> &"ICONST_0">,
500          <MVvisitInsn <MV> &IRETURN>,
501          <MVvisitLabel <MV> s.label>;;
502      },
503      {
504        e.ress : e t.var e, <Lookup-Var t.var> : Expr s.i,
505          <Lookup-TMP-Var t.var> :: s.j,
506          <MVvisitVarInsn <MV> &ALOAD s.j>
507          <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Result" "getExpr" "()Lorg/refal/plus/Expr;">,
508          <MVvisitVarInsn <MV> &ASTORE s.i>,
509          $fail;;
510      };
511  }, $fail; e;
512};
513
514
515$func Term-Ref-To-JBC t.term = ;
516
517Expr-Ref-To-JBC {
518  /*empty*/ = <MVvisitFieldInsn <MV> &GETSTATIC "org/refal/plus/Expr" "empty" "Lorg/refal/plus/Expr;">;
519  t.term = <Term-Ref-To-JBC t.term>;
520  t.term1 t.term2 =
521    <Term-Ref-To-JBC t.term1>,
522    <Term-Ref-To-JBC t.term2>,
523    <MVvisitMethodInsn <MV> &INVOKESTATIC "org/refal/plus/Expr" "concat" "(Lorg/refal/plus/Expr;Lorg/refal/plus/Expr;)Lorg/refal/plus/Expr;">;
524  e.expr =
525    <MVvisitLdcInsn <MV> <Integer <Length e.expr>>>,
526    <MVvisitTypeInsn <MV> &ANEWARRAY "org/refal/plus/Expr">,
527    0 e.expr $iter {
528      e.expr : t.term e.rest,
529        <MVvisitInsn <MV> &DUP>,
530        <MVvisitLdcInsn <MV> <Integer s.i>>,
531        <Term-Ref-To-JBC t.term>,
532        <MVvisitInsn <MV> &AASTORE>,
533        <"+" s.i 1> e.rest;
534    } :: s.i e.expr,
535    e.expr : /*empty*/ =
536    <MVvisitMethodInsn <MV> &INVOKESTATIC "org/refal/plus/Expr" "concat" "([Lorg/refal/plus/Expr;)Lorg/refal/plus/Expr;">;
537};
538
539Term-Ref-To-JBC {
540  (PAREN e.expr) =
541    <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Expr">,
542    <MVvisitInsn <MV> &DUP>,
543    <Expr-Ref-To-JBC e.expr>,
544    <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Expr" "<init>" "(Ljava/lang/Object;)V">;
545  (DEREF e.expr (e.pos)) =
546    <Expr-Ref-To-JBC e.expr>,
547    <Expr-Int-To-JBC e.pos>,
548    <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Expr" "at" "(I)Ljava/lang/Object;">,
549    <MVvisitTypeInsn <MV> &CHECKCAST "org/refal/plus/Expr">;
550  (SUBEXPR e.expr (e.pos) (e.len)) =
551    <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Expr">,
552    <MVvisitInsn <MV> &DUP>,
553    <Expr-Ref-To-JBC e.expr>,
554    <Expr-Int-To-JBC e.pos>,
555    <Expr-Int-To-JBC e.len>,
556    <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Expr" "<init>" "(Lorg/refal/plus/Expr;II)V">;
557  t.term, t.term : \{
558    (REF (e.module s.name)) = e.module s.name;
559    (STATIC (e)) = <? &Module-Name> t.term;
560  } :: e.module t.name =
561    <MVvisitFieldInsn <MV> &GETSTATIC <GetJBCQName e.module t.name> "Lorg/refal/plus/Expr;">;
562  ERROR-EXPR = <Var-To-JBC <Get-Trap>>;
563  t.term, t.term : (s.var-tag e),
564    s.var-tag : \{ VAR; SVAR; TVAR; EVAR; VVAR; } =
565    <Var-To-JBC t.term>;
566};
567
568Expr-Int-To-JBC {
569  s.ObjectSymbol =
570    {
571      <Int? s.ObjectSymbol> =
572        <MVvisitLdcInsn <MV> <Integer s.ObjectSymbol>>;
573      $error ("Illegal int-symbol: " s.ObjectSymbol);
574        //FIXME: надо проверять, что число не
575        //       выходит за допустимые границы.
576        //       Задавать эти границы опциями.
577    };
578  (LENGTH e.x) =
579    <Expr-Ref-To-JBC e.x>,
580    <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Expr" "getLen" "()I">;
581  (s.tag (e.x) (e.y)),
582    s.tag : \{ MIN = "min"; MAX = "max"; } :: s.fn =
583    <Expr-Int-To-JBC e.x>,
584    <Expr-Int-To-JBC e.y>,
585    <MVvisitMethodInsn <MV> &INVOKESTATIC "java/lang/Math" s.fn "(II)I">;
586  (INFIX s.op e.args) =
587    <Infix-To-JBC &Expr-Int-To-JBC s.op e.args>;
588  (INT t.var) = <Var-To-JBC t.var>;
589  e.expr = <Infix-To-JBC &Expr-Int-To-JBC "+" <Paren e.expr>>;
590};
591
592Infix-To-JBC s.arg2java s.op (e.arg) e.args =
593  s.op : \{
594    "+" = &IADD;
595    "-" = &ISUB;
596    "%" = &IREM;
597    "*" = &IMUL;
598    "/" = &IDIV;
599  } :: s.jbcop,
600  <Apply s.arg2java e.arg> : e,
601  {
602    e.args : e (e.arg2) e,
603      <Apply s.arg2java e.arg2> : e,
604      <MVvisitInsn <MV> s.jbcop>,
605      $fail;;
606  };
607
608Cond-To-JBC {
609  (CALL-FAILS (CALL (e.module s.name) (e.args) (e.ress))) =
610    <Function-Description (e.args) (e.ress) "Z"> :: s.desc,
611    {
612      e.args : e (e.arg) e,
613        <Expr-Ref-To-JBC e.arg>,
614        $fail;;
615    },
616    {
617      e.ress : e t.var e, <Lookup-Var t.var> :
618        {
619          Expr s =
620            <Bind-TMP-Var t.var> :: s.j,
621            <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Result">,
622            <MVvisitInsn <MV> &DUP>,
623            <MVvisitInsn <MV> &DUP>,
624            <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Result" "<init>" "()V">,
625            <MVvisitVarInsn <MV> &ASTORE s.j>;
626          Result s.i =
627            <MVvisitVarInsn <MV> &ALOAD s.i>;
628        }, $fail;;
629    },
630    <MVvisitMethodInsn <MV> &INVOKESTATIC <GetJBCQName e.module s.name> s.desc>,
631    {
632      e.ress : e t.var e, <Lookup-Var t.var> : Expr s.i,
633        <Lookup-TMP-Var t.var> :: s.j,
634        <MVvisitVarInsn <MV> &ALOAD s.j>
635        <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Result" "getExpr" "()Lorg/refal/plus/Expr;">,
636        <MVvisitVarInsn <MV> &ASTORE s.i>,
637        $fail;;
638    },
639    &IFNE;
640  (ITER-FAILS e.expr) =
641    <Lookup-Iter-Var e.expr> :: s.i s s,
642    <MVvisitVarInsn <MV> &ALOAD s.i>,
643    <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Expr$SplitIterator" "isValid" "()Z">,
644    &IFNE;
645  (SYMBOL? e.expr (e.pos)) =
646    <Expr-Ref-To-JBC e.expr>,
647    <Expr-Int-To-JBC e.pos>,
648    <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Expr" "symbolAt" "(I)Z">,
649    &IFEQ;
650  (EQ e.expr1 (e.expr2) (e.pos)) =
651    <Expr-Ref-To-JBC e.expr1>,
652    <Expr-Ref-To-JBC e.expr2>,
653    <Expr-Int-To-JBC e.pos>,
654    <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Expr" "eq" "(Lorg/refal/plus/Expr;I)Z">,
655    &IFEQ;
656  (TERM-EQ e.expr1 (e.expr2) (e.pos)) =
657    <Expr-Ref-To-JBC e.expr1>,
658    <Expr-Ref-To-JBC e.expr2>,
659    <Expr-Int-To-JBC e.pos>,
660    <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Expr" "termEq" "(Lorg/refal/plus/Expr;I)Z">,
661    &IFEQ;
662  (NOT t.cond) =
663    <Cond-To-JBC t.cond> : {
664      &IFEQ = &IFNE;
665      &IFNE = &IFEQ;
666    };
667};
668
669
670Step-To-JBC {
671  /*empty*/ = /*empty*/;
672  (s.tag e.expr),
673    s.tag : {
674      INC-ITER = "next";
675      DEC-ITER = "prev";
676    } :: s.m =
677    <Lookup-Iter-Var e.expr> :: s.i s s,
678    <MVvisitVarInsn <MV> &ALOAD s.i>,
679    <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Expr$SplitIterator" s.m "()Lorg/refal/plus/Expr$SplitIterator;">,
680    <MVvisitInsn <MV> &POP>;
681};
682
683$func Const-Term-To-JBC t.term = ;
684$func Get-String-From-Const-Expr e.expr = (e.chars) e.expr;
685$func Convert-Const-Expr e.expr = e.expr;
686
687Const-Expr-To-JBC {
688  /*empty*/ = <MVvisitFieldInsn <MV> &GETSTATIC "org/refal/plus/Expr" "empty" "Lorg/refal/plus/Expr;">;
689  (SUBEXPR t.name s.pos s.len) =
690    t.name : \{
691      (REF (e.module s.obj-name)) = e.module s.obj-name;
692      (STATIC (e)) = <? &Module-Name> t.name;
693    } :: e.module t.name =
694    <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Expr">,
695    <MVvisitInsn <MV> &DUP>,
696    <MVvisitFieldInsn <MV> &GETSTATIC <GetJBCQName e.module t.name> "Lorg/refal/plus/Expr;">,
697    <MVvisitLdcInsn <MV> <Integer s.pos>>,
698    <MVvisitLdcInsn <MV> <Integer s.len>>,
699    <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Expr" "<init>" "(Lorg/refal/plus/Expr;II)V">;
700                  //FIXME: надо проверять, что s.pos и s.len
701                  //       не превышают допустимых величин.
702                  //       Задавать эти величины опциями.
703
704  e.expr = <Convert-Const-Expr e.expr> :: e.expr,
705    <MVvisitLdcInsn <MV> <Integer <Length e.expr>>>,
706    <MVvisitTypeInsn <MV> &ANEWARRAY "org/refal/plus/Expr">,
707    0 e.expr $iter {
708      e.expr : t.term e.rest,
709        <MVvisitInsn <MV> &DUP>,
710        <MVvisitLdcInsn <MV> <Integer s.i>>,
711        <Const-Term-To-JBC t.term>,
712        <MVvisitInsn <MV> &AASTORE>,
713        <"+" s.i 1> e.rest;
714    } :: s.i e.expr,
715    e.expr : /*empry*/ =
716    <MVvisitMethodInsn <MV> &INVOKESTATIC "org/refal/plus/Expr" "concat" "([Lorg/refal/plus/Expr;)Lorg/refal/plus/Expr;">;
717
718
719
720
721  /*e.expr =
722    <Const-Expr-Aux () e.expr> : {
723      (e.arrays) (e1)      = e.arrays (e1);
724      (e.arrays) (e1) (e2) = e.arrays ('new Expr ('e1', 'e2')');
725      (e.arrays) e.concat  =
726        '_va_' :: e.new-var,
727        e.arrays
728        ('static private final Expr[] 'e.new-var' = { '<Concat <Intersperse (', ') e.concat>>' };')
729        ('Expr.concat ('e.new-var')');
730    };*/
731};
732
733Get-String-From-Const-Expr e.expr,
734  () e.expr F $iter {
735    e.expr : s.sym e.rest, <Char? s.sym> = (e.chars s.sym) e.rest F;
736    (e.chars) e.expr T;
737  } :: (e.chars) e.expr s.flag, s.flag : T,
738  (e.chars) e.expr;
739
740Convert-Const-Expr e.expr,
741  () e.expr $iter {
742    <Get-String-From-Const-Expr e.expr> :: (e.chars) e.expr,
743      {
744        e.chars : v = (e.res (CHARS e.chars)) e.expr;
745        e.expr : t.term e.rest, (e.res t.term) e.rest;
746      };
747  } :: (e.res) e.expr, e.expr : /*empry*/,
748  e.res;
749
750Const-Term-To-JBC {
751  (CHARS e.chars) =
752    <MVvisitLdcInsn <MV> <WordToString <To-Word e.chars>>>,
753    <MVvisitMethodInsn <MV> &INVOKESTATIC "org/refal/plus/Expr" "fromSequence" "(Ljava/lang/CharSequence;)Lorg/refal/plus/Expr;">;
754  (PAREN e.expr) =
755    <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Expr">,
756    <MVvisitInsn <MV> &DUP>,
757    <Const-Expr-To-JBC e.expr>,
758    <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Expr" "<init>" "(Ljava/lang/Object;)V">;
759  t.term, t.term : \{
760    (REF (e.module s.name)) = e.module s.name;
761    (STATIC (e)) = <? &Module-Name> t.term;
762  } :: e.module t.name =
763    <MVvisitFieldInsn <MV> &GETSTATIC <GetJBCQName e.module t.name> "Lorg/refal/plus/Expr;">;
764  (s.func (e.module s.name)), s.func : \{ FUNC; FUNC?; } =
765    <To-Word <? &Class-Name> '$' <Length <? &Func-Refs>>> :: s.cl-name,
766    <Put &Func-Refs (<Length <? &Func-Refs>> <GetJBCQName e.module s.name> s.func)>,
767    <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Expr">,
768    <MVvisitInsn <MV> &DUP>,
769    <MVvisitTypeInsn <MV> &NEW s.cl-name>,
770    <MVvisitInsn <MV> &DUP>,
771    <MVvisitMethodInsn <MV> &INVOKESPECIAL s.cl-name "<init>" "()V">,
772    <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Expr" "<init>" "(Ljava/lang/Object;)V">;
773  s.sym, {
774    <Int? s.sym> =
775      <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Expr">,
776      <MVvisitInsn <MV> &DUP>,
777      <MVvisitTypeInsn <MV> &NEW "java/math/BigInteger">,
778      <MVvisitInsn <MV> &DUP>,
779      <MVvisitLdcInsn <MV> <WordToString <To-Word s.sym>>>,
780      <MVvisitMethodInsn <MV> &INVOKESPECIAL "java/math/BigInteger" "<init>" "(Ljava/lang/String;)V">,
781      <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Expr" "<init>" "(Ljava/lang/Object;)V">;
782    <Word? s.sym> =
783      <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Expr">,
784      <MVvisitInsn <MV> &DUP>,
785      <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Word">,
786      <MVvisitInsn <MV> &DUP>,
787      <MVvisitLdcInsn <MV> <WordToString s.sym>>,
788      <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Word" "<init>" "(Ljava/lang/String;)V">,
789      <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Expr" "<init>" "(Ljava/lang/Object;)V">;
790  };
791};
792
793Var-To-JBC t.var =
794  <Lookup-Var t.var> :: s.type s.i,
795  s.type : {
796    Result =
797      <MVvisitVarInsn <MV> &ALOAD s.i>,
798      <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Result" "getExpr" "()Lorg/refal/plus/Expr;">;
799    Expr =
800      <MVvisitVarInsn <MV> &ALOAD s.i>;
801    Int =
802      <MVvisitVarInsn <MV> &ILOAD s.i>;
803  };
804
805Access-Mode {
806  EXPORT = &"ACC_PUBLIC";
807  s = 0;
808};
Note: See TracBrowser for help on using the repository browser.