// $Id$ $use Access Apply Arithm Box Class Compare Convert JavaMangle List StdIO Table; $use "rfpc"; $use "rfp_helper"; $box Int; $box Exports; $table Inputs; $box Module-Name; $box Entry; $box Entry-Name; $box Current-Namespace; $box Func-Name; $box Ress; $table Result; $box Res-Assigns; $table Iter-Vars; $func ASAIL-To-Java e.body = e.java-code; $func Expr-To-Java (e.ASAIL-Expr-init ) e.ASAIL-Expr-rest = e.aux-arrays (e.java-expr); $func Expr-Ref-To-Java e.ASAIL-Expr-Ref = e.aux-arrays (e.JAVA-Expr-Ref); $func Expr-Int-To-Java s.acc e.ASAIL-Expr-Int = e.JAVA-Expr-Int; $func Step-To-Java e.step-operators = e.java-step-operators; $func Const-Expr-To-Java e.ASAIL-const-expr = e.aux-arrays (e.JAVA-const-expr); $func Expr-Args-To-Java e.args = e.aux-arrays (e.java-args); $func Int-Args-To-Java s.acc e.args = e.java-args; $func Var-Args-To-Java e.args = e.java-args; $func Symbol-To-Java s.RFP-Symbol = e.JAVA-String; $func Name-To-Java t.name = e.JAVA-Name; $func Var-To-Java t.var = e.java-var; $func Cond-To-Java s.acc e.cond = e.JAVA-Cond; $func Infix-To-Java s.acc s.func-for-converting-args-to-java s.op e.args = e.java-expr; $func Op-Arg-To-Java s.op = s.func-for-converting-args-to-java; $func Access-Mode t.name = e.java-access-mode; $box Free-Idx; $func Free-Index = e.free-index; $func Declare-Results (e.ress) e.acc-java-ress = e.decls (e.java-ress); RFP-ASAIL-To-Java (e.ModuleName) (e.exports) e.asail = , , , { >; ; }, , , { >; ; }, , >, :: e.java-module-name, { : v.java, { : v.name = () ('public static void main (java.lang.String[] args) {' ( ('RefalRuntime.setArgs ("'e.java-module-name'", args);') ('try {' (v.name' (new Result ());') '}') ('catch (RefalException e) {' ( ('java.lang.System.out.println ("$error: " + e);') ('java.lang.System.exit (100);') )'}') )'}');; } :: e.entry, (e.java-module-name) () ('public class 'e.java-module-name'\n{' (v.java e.entry) '}'); (e.java-module-name) (); }; ASAIL-To-Java e.asail, { e.asail : t.item e.rest, t.item : { (s.tag t.name (e.args) (e.ress) e.body), s.tag : \{ FUNC = ('void') /*empty*/; FUNC? = ('boolean') ('return true;'); } :: (e.return-type) e.return = , , { : e t.name e = >;; }, // :: (e.qualifiers) e.n, >, () ('static '' 'e.return-type' ' ' ('') throws RefalException') ('{' ( e.return) '}'); (TRACE t.name) = ; (IF (e.cond) e.body) = :: s.acc, :: e.j-cond, { e.cond : (NOT (CALL e)) = () ( ); ( ) (); } :: (e.if-yes-assigns) (e.if-not-assigns), ('if ('e.j-cond')') ('{' ( e.if-yes-assigns )'}' ) e.if-not-assigns; (FOR (e.cont-label) (e.break-label) (e.cond) (e.step) e.body) = { e.cont-label : t = ': ';; } :: e.cont, { e.break-label : t = ': ';; } :: e.break, :: s.acc, :: e.cond, { e.step : (s.d e.var), s.d : \{ INC-ITER; DEC-ITER; } = : e.new-var t.var1 t.var2, ('Expr '' = 'e.new-var'.getLeft();') ('Expr '' = 'e.new-var'.getRight();');; } :: e.split-vars, (e.break e.cont 'for ( ; 'e.cond'; '')') ('{' ( e.split-vars ) '}'); (LABEL (e.label) e.body) = (': {' () '}'); (TRY e.body) = ('try') ('{' ( ('if (false)' ('throw new RefalException ("''", "''", ' '"This is for avoiding \'Unreachable code\' errors");' ) ) ) '}'); (CATCH-ERROR e.body) = ('catch (RefalException error) {' ( ('Expr err = error.getExpr ();') () ) '}'); RETFAIL = ('return false;'); FATAL = ('throw new RefalException ("''", "''", "Unexpected fail");'); (LSPLIT t.name (e.min) t.var1 t.var2) = :: e.a (e.n), '_va_' :: e.new-var, , :: s.acc, :: e.min, e.a ('Expr.SplitIterator 'e.new-var' = 'e.n'.leftSplit('e.min');'); (RSPLIT t.name (e.min) t.var1 t.var2) = :: e.a (e.n), '_va_' :: e.new-var, , :: s.acc, :: e.min, e.a ('Expr.SplitIterator 'e.new-var' = 'e.n'.rightSplit('e.min');'); (ASSIGN t.var e.expr) = :: e.a (e.j-expr), { : e t.var e = e.a ('.assign ('e.j-expr');'); e.a ('.assign ('e.j-expr');'); e.a (' = 'e.j-expr';'); }; (DECL s.type t.var) = :: e.j-var, { s.type : Result = , ('Result 'e.j-var' = new Result ();'); , ('Expr 'e.j-var' = Expr.empty;'); }; (INT t.var e.expr) = :: s.acc, :: e.expr, ('int '' = 'e.expr';'); (EXPR t.var e.expr) = , :: e.a (e.j-expr), e.a ('Expr '' = 'e.j-expr';'); (DEREF t.var e.expr (e.pos)) = , :: e.a (e.j-expr), :: s.acc, :: e.pos, e.a ('Expr '' = (Expr) 'e.j-expr'.at ('e.pos');'); (SUBEXPR t.var e.expr (e.pos) (e.len)) = , :: e.a (e.j-expr), :: s.acc, :: e.pos, :: e.len, e.a ('Expr '' = new Expr ('e.j-expr', 'e.pos', 'e.len');'); (DROP t.var) = ('.drop ();'); (CONTINUE t.label) = ('continue '';'); (BREAK t.label) = ('break '';'); (ERROR e.expr) = :: e.a (e.j-expr), e.a ('throw new RefalException ('e.j-expr');'); (CONSTEXPR s.linkage t.name (e.comment) e.expr) = { t.name : (STATIC e) = ; // :: (e.qualifiers) e.name = e.name; ; } :: e.n, :: e.a (e.j-expr), e.a ('static '' final Expr 'e.n' = 'e.j-expr';'); (OBJ s.linkage s.tag t.name) = : s1 e2, 'Named' s1 :: e.class-name, , :: (e.qualifiers) e.n, ('static '' final Expr ' ' = new Expr (new 'e.class-name' ("'e.n'"));'); (DECL-OBJ t.name) = ; (DECL-FUNC t.name) = ; /* * s.call can be CALL or TAILCALL or TAILCALL? */ (s.call t.name (e.args) (e.ress)) = :: e.decls (e.ress), :: e.arrays (e.args), ' ('e.args')' :: e.c, { s.call : TAILCALL? = e.arrays e.decls ('if (!'e.c') {' ('return false;') '}'); e.arrays e.decls (e.c';') ; }; } :: e.java-item, { e.java-item : ('break ' e) = e.java-item; e.java-item ; }; /*empty*/; }; Declare-Results { (t.var e.r) e.ress, { = )>; : e t.var e = )>; '_va_' :: e.new-var, ' = 'e.new-var'.getExpr ();')> = ('Result 'e.new-var' = new Result ();') ; }; () e.ress = (e.ress); }; /* * Determine type of e.expr - int or Refal. */ Expr-To-Java (e.init) e.expr-all, e.expr-all : { /*empty*/ = ; (PAREN e.expr) e.rest = ; (EXPR e.expr) e.rest = ; (DEREF e.expr) e.rest = ; (SUBEXPR e.expr) e.rest = ; (LENGTH e.expr) e.rest = (); (MAX e.args) e.rest = (); (MIN e.args) e.rest = (); (INFIX s.op e.args) e.rest = (); (s.var-tag (e.QualifiedName)) e.rest = ; }; $func Term-Ref-To-Java s.acc term = e.term; Expr-Ref-To-Java { /*empty*/ = ('Expr.empty'); term = :: s.acc, :: e.term, (e.term); t1 t2 = :: s.acc, :: e.t1, :: e.t2, ('new Expr ('e.t1', 'e.t2')'); expr = '_va_' :: e.new-var, :: s.acc, > :: e.arr-init, ('Expr[] 'e.new-var' = { 'e.arr-init' };') ('Expr.concat ('e.new-var')'); }; Term-Ref-To-Java s.acc term = term : { (PAREN e.expr) = :: e.a (e.j-expr), , 'new Expr('e.j-expr')'; (DEREF e.expr (e.pos)) = :: e.a (e.j-expr), , :: e.pos, '(Expr) 'e.j-expr'.at ('e.pos')'; (SUBEXPR e.expr (e.pos) (e.len)) = :: e.a (e.j-expr), , :: e.pos, :: e.len, 'new Expr ('e.j-expr', 'e.pos', 'e.len')'; (REF t.name) = ; ERROR-EXPR = 'err'; (s.var-tag e.ns t.name) = ; }; Expr-Int-To-Java s.acc expr = expr : { // /*empty*/ = /*empty*/; s.ObjectSymbol = { = s.ObjectSymbol; $error ("Illegal int-symbol: " s.ObjectSymbol); //FIXME: надо проверять, что число не // выходит за допустимые границы. // Задавать эти границы опциями. }; (LENGTH e.expr) = :: e.a (e.j-expr), , e.j-expr'.getLen ()'; (MAX e.args) = 'java.lang.Math.max ('')'; (MIN e.args) = 'java.lang.Math.min ('')'; (INFIX s.op e.args) = '(' ')'; // (REF t.name) = ; (s.var-tag t.name) = ; expr = '(' > ')'; }; Cond-To-Java s.acc expr = expr : { /*empty*/ = /*empty*/; (CALL t.name (e.args) (e.ress)) = :: e.decls (e.ress), :: e.arrays (e.args), , ' ('e.args')'; (SYMBOL? e.expr (e.pos)) = :: e.a (e.j-expr), , e.j-expr'.symbolAt ('')'; (CHECK-ITER e.expr) = >'.isValid ()'; (EQ e.expr1 (e.expr2) (e.pos)) = :: e.a1 (e.j-expr1), :: e.a2 (e.j-expr2), , e.j-expr1'.eq ('e.j-expr2', '')'; (TERM-EQ e.expr1 (e.expr2) (e.pos)) = :: e.a1 (e.j-expr1), :: e.a2 (e.j-expr2), , e.j-expr1'.eq ('e.j-expr2', ' ')'; (NOT e.cond) = '!' ; (INFIX s.op e.args) = { s.op : \{ "+"; "-"; "%"; "*"; "/"; } = ' != 0'; '(' s.op e.args> ')'; }; expr = '(' > ')'; }; Infix-To-Java s.acc s.arg2java s.op e.args, { e.args : (e.arg) e.rest = :: e.arg, :: e.rest, { e.arg : v, e.rest : v = e.arg ' ' s.op ' ' e.rest; e.arg e.rest; };; }; Op-Arg-To-Java s.op, { s.op : \{ "&&"; "||"; } = &Cond-To-Java; s.op : \{ "<"; ">"; "<="; ">="; "=="; "!="; "+"; "-"; "%"; "*"; "/"; } = &Expr-Int-To-Java; }; Step-To-Java { /*empty*/ = /*empty*/; (INC-ITER e.expr) = >'.next ()'; (DEC-ITER e.expr) = >'.prev ()'; }; $func Const-Expr-Aux (e.accum) e.expr = (e.arrays) e.java-expr; Const-Expr-To-Java { /*empty*/ = ('Expr.empty'); (SUBEXPR t.name s.pos s.len) = ('new Expr ('', 's.pos', 's.len')'); //FIXME: надо проверять, что s.pos и s.len // не превышают допустимых величин. // Задавать эти величины опциями. e.expr = : { (e.arrays) (e1) = e.arrays (e1); (e.arrays) (e1) (e2) = e.arrays ('new Expr ('e1', 'e2')'); (e.arrays) e.concat = '_va_' :: e.new-var, e.arrays ('static private final Expr[] 'e.new-var' = { '>' };') ('Expr.concat ('e.new-var')'); }; }; Const-Expr-Aux (e.accum) e.expr, { e.expr : s.sym e.rest, = ) e.rest>; e.accum : v = :: (e.arrays) e.j-expr, (e.arrays) ('Expr.fromSequence ("'e.accum'")') e.j-expr; e.expr : t.item e.rest, t.item : { (PAREN e.paren-expr) = :: e.arrays (e.j-expr), (e.arrays) ('new Expr ('e.j-expr')'); (REF t.name) = () (); (STATIC e) = () (); (FUNC? t.name) = () ('new Expr (new Func () {' ('public boolean eval (Expr arg, Result res) throws RefalException {' ('return '' (arg, res);') '}') '})'); (FUNC t.name) = () ('new Expr (new Func () {' ('public boolean eval (Expr arg, Result res) throws RefalException {' ((' (arg, res);') ('return true;')) '}') '})'); s.sym, { = { : BigInteger = ;; }, () ('new Expr (new '' ("'s.sym'"))'); = () ('new Expr (new Word ("''"))'); }; } :: (e.arrays) e.java-item = :: (e.new-arrays) e.java-rest, (e.arrays e.new-arrays) e.java-item e.java-rest; = () /*empty*/; }; Symbol-To-Java s.ObjectSymbol, { () $iter { e.symbol : s.char e.rest, s.char : { '\\' = '\\\\'; '\n' = '\\n'; '\t' = '\\t'; // '\v' = '\\v'; // '\b' = '\\b'; '\r' = '\\r'; // '\f' = '\\f'; '\"' = '\\"'; // '\'' = '\\\''; s = s.char; } :: e.java-char, e.rest (e.java-symbol e.java-char); } :: e.symbol (e.java-symbol), e.symbol : /*empty*/ = e.java-symbol; }; Int-Args-To-Java s.acc e.args = e.args (/*e.java-args*/) $iter { e.args : (e.arg) e.rest = { e.rest : v = ', '; /*empty*/; } :: e.comma, e.rest (e.java-args e.comma); } :: e.args (e.java-args), e.args : /*empty*/ = e.java-args; Var-Args-To-Java e.args = e.args (/*e.type*/) (/*e.java-args*/) $iter { e.args : s.t e.rest = e.rest (s.t) (e.java-args); e.args : t.arg e.rest = { e.rest : e (e) e = ', '; /*empty*/; } :: e.comma, e.rest (e.type) (e.java-args e.type' ' e.comma); } :: e.args (e.type) (e.java-args), e.args : /*empty*/ = e.java-args; Expr-Args-To-Java e.args = e.args (/*e.type*/) (/*e.java-args*/) (/*e.arrays*/) $iter { e.args : s.t e.rest = e.rest (s.t) (e.java-args) (e.arrays); e.args : (e.arg) e.rest = { e.rest : e (e) e = ', '; /*empty*/; } :: e.comma, { e.type : /*empty*/ = :: e.a (e.j-arg), e.rest (e.type) (e.java-args e.j-arg e.comma) (e.arrays e.a); e.rest (e.type) (e.java-args e.arg e.comma) (e.arrays); }; } :: e.args (e.type) (e.java-args) (e.arrays), e.args : /*empty*/ = e.arrays (e.java-args); Name-To-Java t.obj-name = :: (e.qualifiers) e.name, :: e.namespace, { e.qualifiers : e.namespace e.cont = ; , ; }; Var-To-Java t.var = { '.getExpr ()'; ; }; Access-Mode t.name, { : e t.name e = 'public'; 'private'; }; Free-Index = : { /*empty*/ = 1; s.idx = <"+" s.idx 1>; } :: s.idx, , s.idx;