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

Last change on this file since 2474 was 2474, checked in by orlov, 14 years ago
  • No variable declarations with DEREF and SUBEXPR in ASAIL.
  • Typo fixed: EXPORTS -> EXPORT in asail_java and asail_jbc.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 28.4 KB
Line 
1// $Id: rfp_asail_jbc.rf 2474 2007-02-26 21:51:18Z 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 s.type t.var) =
332      <Bind-Var s.type t.var> :: s.i,
333      s.type : {
334        Result =
335          <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Result">,
336          <MVvisitInsn <MV> &DUP>,
337          <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Result" "<init>" "()V">,
338          <MVvisitVarInsn <MV> &ASTORE s.i>;
339        Expr =
340          <MVvisitFieldInsn <MV> &GETSTATIC "org/refal/plus/Expr" "empty" "Lorg/refal/plus/Expr;">,
341          <MVvisitVarInsn <MV> &ASTORE s.i>;
342      };
343    (ASSIGN t.var e.expr) =
344      <Lookup-Var t.var> :: s.type s.i,
345      s.type : {
346        Result =
347          <MVvisitVarInsn <MV> &ALOAD s.i>,
348          <Expr-Ref-To-JBC e.expr>,
349          <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Result" "assign" "(Lorg/refal/plus/Expr;)V">;
350        Expr =
351          <Expr-Ref-To-JBC e.expr>,
352          <MVvisitVarInsn <MV> &ASTORE s.i>;
353      };
354    (INT t.var e.expr) =
355      <Bind-Var Int t.var> :: s.i,
356      <Expr-Int-To-JBC e.expr>,
357      <MVvisitVarInsn <MV> &ISTORE s.i>;
358    (EXPR t.var e.expr) =
359      <Bind-Var Expr t.var> :: s.i,
360      <Expr-Ref-To-JBC e.expr>,
361      <MVvisitVarInsn <MV> &ASTORE s.i>;
362    (IF-INT-CMP s.op (e.arg1) (e.arg2) e.body) =
363      <Push-Block-Table>,
364      <Label> :: s.label,
365      <Expr-Int-To-JBC e.arg1>,
366      <Expr-Int-To-JBC e.arg2>,
367      s.op : {
368        "!=" = &"IF_ICMPEQ";
369        "<" = &"IF_ICMPGE";
370        ">" = &"IF_ICMPLE";
371      } :: s.op,
372      <MVvisitJumpInsn <MV> s.op s.label>,
373      <ASAIL-To-JBC e.body>,
374      <MVvisitLabel <MV> s.label>,
375      <Pop-Block-Table>;
376    (IF t.cond e.body) =
377      <Push-Block-Table>,
378      <Label> :: s.label,
379      <Cond-To-JBC t.cond> :: s.if,
380      <MVvisitJumpInsn <MV> s.if s.label>,
381      <ASAIL-To-JBC e.body>,
382      <MVvisitLabel <MV> s.label>,
383      <Pop-Block-Table>;
384    (LSPLIT t.name (e.min) t.var1 t.var2) =
385      <Push-Block-Table>,
386      <Bind-Iter-Var t.name t.var1 t.var2> :: s.i,
387      <Expr-Ref-To-JBC t.name>,
388      <Expr-Int-To-JBC e.min>,
389      <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Expr" "leftSplit" "(I)Lorg/refal/plus/Expr$SplitIterator;">,
390      <MVvisitVarInsn <MV> &ASTORE s.i>;
391    (RSPLIT t.name (e.min) t.var1 t.var2) =
392      <Push-Block-Table>,
393      <Bind-Iter-Var t.name t.var1 t.var2> :: s.i,
394      <Expr-Ref-To-JBC t.name>,
395      <Expr-Int-To-JBC e.min>,
396      <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Expr" "rightSplit" "(I)Lorg/refal/plus/Expr$SplitIterator;">,
397      <MVvisitVarInsn <MV> &ASTORE s.i>;
398    (FOR (e.cont-label) (e.break-label) () (e.step) e.body) =
399      { e.step : /*empty*/, <Push-Block-Table>;; },
400      {
401        e.cont-label : t.label = <Bind-Label t.label>;
402        <Label>;
403      } :: s.cont-label,
404      {
405        e.break-label : t.label = <Bind-Label t.label>;
406        <Label>;
407      } :: s.break-label,
408      <Label> :: s.for-label,
409      <MVvisitLabel <MV> s.for-label>,
410      {
411        e.step : (s.tag e.expr), s.tag : \{ INC-ITER; DEC-ITER; } =
412          <Lookup-Iter-Var e.expr> : s.i s.i1 s.i2,
413          <MVvisitVarInsn <MV> &ALOAD s.i>,
414          <MVvisitInsn <MV> &DUP>,
415          <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Expr$SplitIterator" "getLeft" "()Lorg/refal/plus/Expr;">,
416          <MVvisitVarInsn <MV> &ASTORE s.i1>,
417          <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Expr$SplitIterator" "getRight" "()Lorg/refal/plus/Expr;">,
418          <MVvisitVarInsn <MV> &ASTORE s.i2>;;
419      },
420      <ASAIL-To-JBC e.body>,
421      <MVvisitLabel <MV> s.cont-label>,
422      <Step-To-JBC e.step>,
423      <MVvisitJumpInsn <MV> &GOTO s.for-label>,
424      <MVvisitLabel <MV> s.break-label>,
425      <Pop-Block-Table>;
426    (LABEL (t.label) e.body) =
427      <Push-Block-Table>,
428      <Bind-Label t.label> :: s.l,
429      <ASAIL-To-JBC e.body>,
430      <MVvisitLabel <MV> s.l>,
431      <Pop-Block-Table>;
432    (s.tag t.label), s.tag : \{ CONTINUE; BREAK; } =
433      <MVvisitJumpInsn <MV> &GOTO <Lookup-Label t.label>>;
434    RETFAIL =
435      <MVvisitInsn <MV> &"ICONST_0"> <MVvisitInsn <MV> &IRETURN>;
436    (TRY e.body) =
437      <Push-Block-Table>,
438      <Label> :: s.start,
439      <Label> :: s.end,
440      <Label> :: s.real-end,
441      <Label> :: s.handler,
442      <Push-Trap s.real-end s.handler>,
443      <MVvisitTryCatchBlock <MV> s.start s.end s.handler "org/refal/plus/RefalException">,
444      <MVvisitLabel <MV> s.start>,
445      <ASAIL-To-JBC e.body>,
446      <MVvisitLabel <MV> s.end>,
447      <MVvisitJumpInsn <MV> &GOTO s.real-end>,
448      <Pop-Block-Table>;
449    (CATCH-ERROR e.body) =
450      <Push-Block-Table>,
451      <Get-Trap> :: s.label,
452      <MVvisitLabel <MV> s.label>,
453      <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/RefalException" "getExpr" "()Lorg/refal/plus/Expr;">,
454      <MVvisitVarInsn <MV> &ASTORE <Bind-Var Expr s.label>>,
455      <ASAIL-To-JBC e.body>,
456      <MVvisitLabel <MV> <Pop-Trap>>,
457      <Pop-Block-Table>;
458    FATAL =
459      <MVvisitTypeInsn <MV> &NEW "org/refal/plus/RefalException">,
460      <MVvisitInsn <MV> &DUP>,
461      <? &Refal-Module-Name> : s.mod-name,
462      <MVvisitLdcInsn <MV> <WordToString s.mod-name>>,
463      <? &Func-Name> : s.fname,
464      <MVvisitLdcInsn <MV> <WordToString s.fname>>,
465      <MVvisitLdcInsn <MV> <WordToString "Unexpected fail">>,
466      <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/RefalException" "<init>" "(Ljava/lang/String;Ljava/lang/String;Ljava/lang/String;)V">,
467      <MVvisitInsn <MV> &ATHROW>;
468    (ERROR e.expr) =
469      <MVvisitTypeInsn <MV> &NEW "org/refal/plus/RefalException">,
470      <MVvisitInsn <MV> &DUP>,
471      <Expr-Ref-To-JBC e.expr>,
472      <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/RefalException" "<init>" "(Lorg/refal/plus/Expr;)V">,
473      <MVvisitInsn <MV> &ATHROW>;
474    (s.call (e.module s.name) (e.args) (e.ress)),
475      s.call : \{ CALL = V; TAILCALL = V; TAILCALL? = Z; } :: s.retType =
476      <Function-Description (e.args) (e.ress) s.retType> :: s.desc,
477      {
478        e.args : e (e.arg) e,
479          <Expr-Ref-To-JBC e.arg>,
480          $fail;;
481      },
482      {
483        e.ress : e t.var e, <Lookup-Var t.var> :
484          {
485            Expr s =
486              <Bind-TMP-Var t.var> :: s.j,
487              <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Result">,
488              <MVvisitInsn <MV> &DUP>,
489              <MVvisitInsn <MV> &DUP>,
490              <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Result" "<init>" "()V">,
491              <MVvisitVarInsn <MV> &ASTORE s.j>;
492            Result s.i =
493              <MVvisitVarInsn <MV> &ALOAD s.i>;
494          }, $fail;;
495      },
496      <MVvisitMethodInsn <MV> &INVOKESTATIC <GetJBCQName e.module s.name> s.desc>,
497      {
498        s.call : TAILCALL? =
499          <Label> :: s.label,
500          <MVvisitJumpInsn <MV> &IFNE s.label>,
501          <MVvisitInsn <MV> &"ICONST_0">,
502          <MVvisitInsn <MV> &IRETURN>,
503          <MVvisitLabel <MV> s.label>;;
504      },
505      {
506        e.ress : e t.var e, <Lookup-Var t.var> : Expr s.i,
507          <Lookup-TMP-Var t.var> :: s.j,
508          <MVvisitVarInsn <MV> &ALOAD s.j>
509          <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Result" "getExpr" "()Lorg/refal/plus/Expr;">,
510          <MVvisitVarInsn <MV> &ASTORE s.i>,
511          $fail;;
512      };
513  }, $fail; e;
514};
515
516
517$func Term-Ref-To-JBC t.term = ;
518
519Expr-Ref-To-JBC {
520  /*empty*/ = <MVvisitFieldInsn <MV> &GETSTATIC "org/refal/plus/Expr" "empty" "Lorg/refal/plus/Expr;">;
521  t.term = <Term-Ref-To-JBC t.term>;
522  t.term1 t.term2 =
523    <Term-Ref-To-JBC t.term1>,
524    <Term-Ref-To-JBC t.term2>,
525    <MVvisitMethodInsn <MV> &INVOKESTATIC "org/refal/plus/Expr" "concat" "(Lorg/refal/plus/Expr;Lorg/refal/plus/Expr;)Lorg/refal/plus/Expr;">;
526  e.expr =
527    <MVvisitLdcInsn <MV> <Integer <Length e.expr>>>,
528    <MVvisitTypeInsn <MV> &ANEWARRAY "org/refal/plus/Expr">,
529    0 e.expr $iter {
530      e.expr : t.term e.rest,
531        <MVvisitInsn <MV> &DUP>,
532        <MVvisitLdcInsn <MV> <Integer s.i>>,
533        <Term-Ref-To-JBC t.term>,
534        <MVvisitInsn <MV> &AASTORE>,
535        <"+" s.i 1> e.rest;
536    } :: s.i e.expr,
537    e.expr : /*empty*/ =
538    <MVvisitMethodInsn <MV> &INVOKESTATIC "org/refal/plus/Expr" "concat" "([Lorg/refal/plus/Expr;)Lorg/refal/plus/Expr;">;
539};
540
541Term-Ref-To-JBC {
542  (PAREN e.expr) =
543    <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Expr">,
544    <MVvisitInsn <MV> &DUP>,
545    <Expr-Ref-To-JBC e.expr>,
546    <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Expr" "<init>" "(Ljava/lang/Object;)V">;
547  (DEREF e.expr (e.pos)) =
548    <Expr-Ref-To-JBC e.expr>,
549    <Expr-Int-To-JBC e.pos>,
550    <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Expr" "at" "(I)Ljava/lang/Object;">,
551    <MVvisitTypeInsn <MV> &CHECKCAST "org/refal/plus/Expr">;
552  (SUBEXPR e.expr (e.pos) (e.len)) =
553    <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Expr">,
554    <MVvisitInsn <MV> &DUP>,
555    <Expr-Ref-To-JBC e.expr>,
556    <Expr-Int-To-JBC e.pos>,
557    <Expr-Int-To-JBC e.len>,
558    <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Expr" "<init>" "(Lorg/refal/plus/Expr;II)V">;
559  t.term, t.term : \{
560    (REF (e.module s.name)) = e.module s.name;
561    (STATIC (e)) = <? &Module-Name> t.term;
562  } :: e.module t.name =
563    <MVvisitFieldInsn <MV> &GETSTATIC <GetJBCQName e.module t.name> "Lorg/refal/plus/Expr;">;
564  ERROR-EXPR = <Var-To-JBC <Get-Trap>>;
565  t.term, t.term : (s.var-tag e),
566    s.var-tag : \{ VAR; SVAR; TVAR; EVAR; VVAR; } =
567    <Var-To-JBC t.term>;
568};
569
570Expr-Int-To-JBC {
571  s.ObjectSymbol =
572    {
573      <Int? s.ObjectSymbol> =
574        <MVvisitLdcInsn <MV> <Integer s.ObjectSymbol>>;
575      $error ("Illegal int-symbol: " s.ObjectSymbol);
576        //FIXME: надо проверять, что число не
577        //       выходит за допустимые границы.
578        //       Задавать эти границы опциями.
579    };
580  (LENGTH e.x) =
581    <Expr-Ref-To-JBC e.x>,
582    <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Expr" "getLen" "()I">;
583  (s.tag (e.x) (e.y)),
584    s.tag : \{ MIN = "min"; MAX = "max"; } :: s.fn =
585    <Expr-Int-To-JBC e.x>,
586    <Expr-Int-To-JBC e.y>,
587    <MVvisitMethodInsn <MV> &INVOKESTATIC "java/lang/Math" s.fn "(II)I">;
588  (INFIX s.op e.args) =
589    <Infix-To-JBC &Expr-Int-To-JBC s.op e.args>;
590  t.term, t.term : (s.var-tag e) = <Var-To-JBC t.term>;
591  e.expr = <Infix-To-JBC &Expr-Int-To-JBC "+" <Paren e.expr>>;
592};
593
594Infix-To-JBC s.arg2java s.op (e.arg) e.args =
595  s.op : \{
596    "+" = &IADD;
597    "-" = &ISUB;
598    "%" = &IREM;
599    "*" = &IMUL;
600    "/" = &IDIV;
601  } :: s.jbcop,
602  <Apply s.arg2java e.arg> : e,
603  {
604    e.args : e (e.arg2) e,
605      <Apply s.arg2java e.arg2> : e,
606      <MVvisitInsn <MV> s.jbcop>,
607      $fail;;
608  };
609
610Cond-To-JBC {
611  (CALL-FAILS (CALL (e.module s.name) (e.args) (e.ress))) =
612    <Function-Description (e.args) (e.ress) "Z"> :: s.desc,
613    {
614      e.args : e (e.arg) e,
615        <Expr-Ref-To-JBC e.arg>,
616        $fail;;
617    },
618    {
619      e.ress : e t.var e, <Lookup-Var t.var> :
620        {
621          Expr s =
622            <Bind-TMP-Var t.var> :: s.j,
623            <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Result">,
624            <MVvisitInsn <MV> &DUP>,
625            <MVvisitInsn <MV> &DUP>,
626            <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Result" "<init>" "()V">,
627            <MVvisitVarInsn <MV> &ASTORE s.j>;
628          Result s.i =
629            <MVvisitVarInsn <MV> &ALOAD s.i>;
630        }, $fail;;
631    },
632    <MVvisitMethodInsn <MV> &INVOKESTATIC <GetJBCQName e.module s.name> s.desc>,
633    {
634      e.ress : e t.var e, <Lookup-Var t.var> : Expr s.i,
635        <Lookup-TMP-Var t.var> :: s.j,
636        <MVvisitVarInsn <MV> &ALOAD s.j>
637        <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Result" "getExpr" "()Lorg/refal/plus/Expr;">,
638        <MVvisitVarInsn <MV> &ASTORE s.i>,
639        $fail;;
640    },
641    &IFNE;
642  (ITER-FAILS e.expr) =
643    <Lookup-Iter-Var e.expr> :: s.i s s,
644    <MVvisitVarInsn <MV> &ALOAD s.i>,
645    <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Expr$SplitIterator" "isValid" "()Z">,
646    &IFNE;
647  (SYMBOL? e.expr (e.pos)) =
648    <Expr-Ref-To-JBC e.expr>,
649    <Expr-Int-To-JBC e.pos>,
650    <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Expr" "symbolAt" "(I)Z">,
651    &IFEQ;
652  (EQ e.expr1 (e.expr2) (e.pos)) =
653    <Expr-Ref-To-JBC e.expr1>,
654    <Expr-Ref-To-JBC e.expr2>,
655    <Expr-Int-To-JBC e.pos>,
656    <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Expr" "eq" "(Lorg/refal/plus/Expr;I)Z">,
657    &IFEQ;
658  (TERM-EQ e.expr1 (e.expr2) (e.pos)) =
659    <Expr-Ref-To-JBC e.expr1>,
660    <Expr-Ref-To-JBC e.expr2>,
661    <Expr-Int-To-JBC e.pos>,
662    <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Expr" "termEq" "(Lorg/refal/plus/Expr;I)Z">,
663    &IFEQ;
664  (NOT t.cond) =
665    <Cond-To-JBC t.cond> : {
666      &IFEQ = &IFNE;
667      &IFNE = &IFEQ;
668    };
669};
670
671
672Step-To-JBC {
673  /*empty*/ = /*empty*/;
674  (s.tag e.expr),
675    s.tag : {
676      INC-ITER = "next";
677      DEC-ITER = "prev";
678    } :: s.m =
679    <Lookup-Iter-Var e.expr> :: s.i s s,
680    <MVvisitVarInsn <MV> &ALOAD s.i>,
681    <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Expr$SplitIterator" s.m "()Lorg/refal/plus/Expr$SplitIterator;">,
682    <MVvisitInsn <MV> &POP>;
683};
684
685$func Const-Term-To-JBC t.term = ;
686$func Get-String-From-Const-Expr e.expr = (e.chars) e.expr;
687$func Convert-Const-Expr e.expr = e.expr;
688
689Const-Expr-To-JBC {
690  /*empty*/ = <MVvisitFieldInsn <MV> &GETSTATIC "org/refal/plus/Expr" "empty" "Lorg/refal/plus/Expr;">;
691  (SUBEXPR t.name s.pos s.len) =
692    t.name : \{
693      (REF (e.module s.obj-name)) = e.module s.obj-name;
694      (STATIC (e)) = <? &Module-Name> t.name;
695    } :: e.module t.name =
696    <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Expr">,
697    <MVvisitInsn <MV> &DUP>,
698    <MVvisitFieldInsn <MV> &GETSTATIC <GetJBCQName e.module t.name> "Lorg/refal/plus/Expr;">,
699    <MVvisitLdcInsn <MV> <Integer s.pos>>,
700    <MVvisitLdcInsn <MV> <Integer s.len>>,
701    <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Expr" "<init>" "(Lorg/refal/plus/Expr;II)V">;
702                  //FIXME: надо проверять, что s.pos и s.len
703                  //       не превышают допустимых величин.
704                  //       Задавать эти величины опциями.
705
706  e.expr = <Convert-Const-Expr e.expr> :: e.expr,
707    <MVvisitLdcInsn <MV> <Integer <Length e.expr>>>,
708    <MVvisitTypeInsn <MV> &ANEWARRAY "org/refal/plus/Expr">,
709    0 e.expr $iter {
710      e.expr : t.term e.rest,
711        <MVvisitInsn <MV> &DUP>,
712        <MVvisitLdcInsn <MV> <Integer s.i>>,
713        <Const-Term-To-JBC t.term>,
714        <MVvisitInsn <MV> &AASTORE>,
715        <"+" s.i 1> e.rest;
716    } :: s.i e.expr,
717    e.expr : /*empry*/ =
718    <MVvisitMethodInsn <MV> &INVOKESTATIC "org/refal/plus/Expr" "concat" "([Lorg/refal/plus/Expr;)Lorg/refal/plus/Expr;">;
719
720
721
722
723  /*e.expr =
724    <Const-Expr-Aux () e.expr> : {
725      (e.arrays) (e1)      = e.arrays (e1);
726      (e.arrays) (e1) (e2) = e.arrays ('new Expr ('e1', 'e2')');
727      (e.arrays) e.concat  =
728        '_va_' :: e.new-var,
729        e.arrays
730        ('static private final Expr[] 'e.new-var' = { '<Concat <Intersperse (', ') e.concat>>' };')
731        ('Expr.concat ('e.new-var')');
732    };*/
733};
734
735Get-String-From-Const-Expr e.expr,
736  () e.expr F $iter {
737    e.expr : s.sym e.rest, <Char? s.sym> = (e.chars s.sym) e.rest F;
738    (e.chars) e.expr T;
739  } :: (e.chars) e.expr s.flag, s.flag : T,
740  (e.chars) e.expr;
741
742Convert-Const-Expr e.expr,
743  () e.expr $iter {
744    <Get-String-From-Const-Expr e.expr> :: (e.chars) e.expr,
745      {
746        e.chars : v = (e.res (CHARS e.chars)) e.expr;
747        e.expr : t.term e.rest, (e.res t.term) e.rest;
748      };
749  } :: (e.res) e.expr, e.expr : /*empry*/,
750  e.res;
751
752Const-Term-To-JBC {
753  (CHARS e.chars) =
754    <MVvisitLdcInsn <MV> <WordToString <To-Word e.chars>>>,
755    <MVvisitMethodInsn <MV> &INVOKESTATIC "org/refal/plus/Expr" "fromSequence" "(Ljava/lang/CharSequence;)Lorg/refal/plus/Expr;">;
756  (PAREN e.expr) =
757    <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Expr">,
758    <MVvisitInsn <MV> &DUP>,
759    <Const-Expr-To-JBC e.expr>,
760    <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Expr" "<init>" "(Ljava/lang/Object;)V">;
761  t.term, t.term : \{
762    (REF (e.module s.name)) = e.module s.name;
763    (STATIC (e)) = <? &Module-Name> t.term;
764  } :: e.module t.name =
765    <MVvisitFieldInsn <MV> &GETSTATIC <GetJBCQName e.module t.name> "Lorg/refal/plus/Expr;">;
766  (s.func (e.module s.name)), s.func : \{ FUNC; FUNC?; } =
767    <To-Word <? &Class-Name> '$' <Length <? &Func-Refs>>> :: s.cl-name,
768    <Put &Func-Refs (<Length <? &Func-Refs>> <GetJBCQName e.module s.name> s.func)>,
769    <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Expr">,
770    <MVvisitInsn <MV> &DUP>,
771    <MVvisitTypeInsn <MV> &NEW s.cl-name>,
772    <MVvisitInsn <MV> &DUP>,
773    <MVvisitMethodInsn <MV> &INVOKESPECIAL s.cl-name "<init>" "()V">,
774    <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Expr" "<init>" "(Ljava/lang/Object;)V">;
775  s.sym, {
776    <Int? s.sym> =
777      <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Expr">,
778      <MVvisitInsn <MV> &DUP>,
779      <MVvisitTypeInsn <MV> &NEW "java/math/BigInteger">,
780      <MVvisitInsn <MV> &DUP>,
781      <MVvisitLdcInsn <MV> <WordToString <To-Word s.sym>>>,
782      <MVvisitMethodInsn <MV> &INVOKESPECIAL "java/math/BigInteger" "<init>" "(Ljava/lang/String;)V">,
783      <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Expr" "<init>" "(Ljava/lang/Object;)V">;
784    <Word? s.sym> =
785      <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Expr">,
786      <MVvisitInsn <MV> &DUP>,
787      <MVvisitTypeInsn <MV> &NEW "org/refal/plus/Word">,
788      <MVvisitInsn <MV> &DUP>,
789      <MVvisitLdcInsn <MV> <WordToString s.sym>>,
790      <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Word" "<init>" "(Ljava/lang/String;)V">,
791      <MVvisitMethodInsn <MV> &INVOKESPECIAL "org/refal/plus/Expr" "<init>" "(Ljava/lang/Object;)V">;
792  };
793};
794
795Var-To-JBC t.var =
796  <Lookup-Var t.var> :: s.type s.i,
797  s.type : {
798    Result =
799      <MVvisitVarInsn <MV> &ALOAD s.i>,
800      <MVvisitMethodInsn <MV> &INVOKEVIRTUAL "org/refal/plus/Result" "getExpr" "()Lorg/refal/plus/Expr;">;
801    Expr =
802      <MVvisitVarInsn <MV> &ALOAD s.i>;
803    Int =
804      <MVvisitVarInsn <MV> &ILOAD s.i>;
805  };
806
807Access-Mode {
808  EXPORT = &"ACC_PUBLIC";
809  s = 0;
810};
Note: See TracBrowser for help on using the repository browser.