java/com/googlecode/prolog_cafe/compiler/am2j.pl [1:1089]: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - /***************************************************************** Time-stamp: <2008-10-29 10:42:42 banbara> NAME am2j: Translating WAM-based Intermediate Code into Java USAGE # sicstus ?- [am2j]. ?- am2j([File]). # sicstus ?- [am2j]. ?- am2j([File, Dir]). PARAMETERS File is an input WAM-based Intermediate file name. DESCRIPTION This program translates WAM-based intermediate codes into Java. For each predicate p/n, the file named "PRED_p_n.java" is generated. Generated files can be compiled and executed by usual java utilities (ex. javac) with the Prolog Cafe runtime system. COPYRIGHT am2j (Translating WAM-based Intermediate Code into Java) Copyright (C) 1997-2008 by Mutsunori Banbara (banbara@kobe-u.ac.jp) and Naoyuki Tamura (tamura@kobe-u.ac.jp) SEE ALSO http://kaminari.istc.kobe-u.ac.jp/PrologCafe/ *****************************************************************/ /***************************************************************** Declarations *****************************************************************/ :- op(1170, xfx, (:-)). :- op(1170, xfx, (-->)). :- op(1170, fx, (:-)). :- op(1170, fx, (?-)). :- op(1150, fx, (public)). :- op(1150, fx, (package)). % Prolog Cafe specific :- dynamic dest_dir/1. :- dynamic current_arity/1. :- dynamic current_package/1. % :- module('com.googlecode.prolog_cafe.compiler.am2j', [main/0,am2j/1]). package(_). :- package 'com.googlecode.prolog_cafe.compiler.am2j'. :- public am2j/1. /***************************************************************** Main *****************************************************************/ am2j([File]) :- !, am2j([File, '.']). am2j([File,Dir]) :- retractall(dest_dir(_)), assert(dest_dir(Dir)), open(File, read, In), repeat, read(In, X), write_java(X, In), X == end_of_file, !, close(In). write_java(X, _) :- var(X), !, am2j_error([unbound,variable,is,found]), fail. write_java(end_of_file, _) :- !. write_java((:- G), _) :- !, call(G). write_java(begin_predicate(P, F/A), In) :- clause(dest_dir(Dir), _), retractall(current_package(_)), retractall(current_arity(_)), assert(current_package(P)), assert(current_arity(A)), predicate_encoding(F, F1), package_encoding(P, PDir), list_to_string([Dir,'/',PDir], SrcDir), list_to_string([SrcDir,'/','PRED_',F1,'_',A,'.java'], SrcFile), mkdirs(SrcDir), open(SrcFile, write, Out), write(Out, 'package '), write_package(P, Out), write(Out, ';'), nl(Out), repeat, read(In, X), write_java0(X, In, Out), X == end_predicate(P, F/A), close(Out), !. write_java(X, _) :- am2j_error([X,is,an,invalid,argument,in,write_java/2]), fail. /***************************************************************** Write Java *****************************************************************/ write_java0(X, _, _) :- var(X), !, am2j_error([unbound,variable,is,found]), fail. write_java0([], _, _) :- !. write_java0([X|Xs], In, Out) :- !, write_java0(X, In, Out), write_java0(Xs, In, Out). write_java0(end_predicate(_, _), _, Out) :- !, tab(Out, 4), write(Out, '}'), nl(Out), write(Out, '}'), nl(Out). write_java0(comment(Comment), _, Out) :- !, numbervars(Comment, 0, _), tab(Out, 4), write(Out, '// '), writeq(Out, Comment), nl(Out). write_java0(debug(Comment), _, Out) :- !, numbervars(Comment, 0, _), write(Out, '// '), writeq(Out, Comment), nl(Out). write_java0(info([FA,File|_]), _, Out) :- !, write(Out, '/*'), nl(Out), write(Out, ' '), writeq(Out, FA), write(Out, ' defined in '), write(Out, File), nl(Out), write(Out, ' This file is generated by Prolog Cafe.'), nl(Out), write(Out, ' PLEASE DO NOT EDIT!'), nl(Out), write(Out, '*/'), nl(Out). write_java0(import_package(P), _, Out) :- !, write(Out, 'import '), write_package(P, Out), write(Out, '.*;'), nl(Out). write_java0(import_static(P,F), _, Out) :- !, write(Out, 'import static '), write_package(P, Out), write(Out, '.'), write(Out, F), write(Out, ';'), nl(Out). write_java0(import_package(P,FA), _, Out) :- !, write(Out, 'import '), write_package(P, Out), write(Out, '.'), (FA = _/_ -> write_class_name(FA, Out) ; write_package(FA, Out) ), write(Out, ';'), nl(Out). write_java0((Label: Instruction), In, Out) :- !, write_label(Label, Out), write_java0(Instruction, In, Out). write_java0(label(L), _, Out) :- !, tab(Out, 4), write(Out, 'static final Operation '), write_index(L, Out), write(Out, ' = new '), write_class_name(L, Out), write(Out, '();'), nl(Out). write_java0(goto(L), _, Out) :- !, tab(Out, 8), write(Out, 'return '), write_index(L, Out), write(Out, ';'), nl(Out). write_java0(setB0, _, Out) :- !, tab(Out, 8), write(Out, 'engine.setB0();'), nl(Out). write_java0(deref(_,void), _, _) :- !. write_java0(deref(Ri,Rj), _, Out) :- !, tab(Out, 8), write_reg(Rj, Out), write(Out, ' = '), write_reg(Ri, Out), write(Out, '.dereference();'), nl(Out). write_java0(set(_,void), _, _) :- !. write_java0(set(Ri,Rj), _, Out) :- !, tab(Out, 8), write_reg(Rj, Out), write(Out, ' = '), write_reg(Ri, Out), write(Out, ';'), nl(Out). write_java0(decl_term_vars([]), _, _) :- !. write_java0(decl_term_vars(L), _, Out) :- !, tab(Out, 8), write(Out, 'Term '), write_reg_args(L, Out), write(Out, ';'), nl(Out). write_java0(decl_pred_vars([]), _, _) :- !. write_java0(decl_pred_vars(L), _, Out) :- !, tab(Out, 8), write(Out, 'Operation '), write_reg_args(L, Out), write(Out, ';'), nl(Out). write_java0(put_cont(BinG,C), _, Out) :- !, (BinG = P:G -> true ; BinG = G), functor(G, F, A0), A is A0-1, G =.. [F|Args], tab(Out, 8), write_reg(C, Out), write(Out, ' = new '), (nonvar(P) -> write_package(P, Out), write(Out, '.') ; true), write_class_name(F/A, Out), write(Out, '('), write_reg_args(Args, Out), write(Out, ');'), nl(Out). write_java0(execute(cont), _, Out) :- !, tab(Out, 8), write(Out, 'return cont;'), nl(Out). write_java0(execute(BinG), _, Out) :- !, (BinG = P:G -> true ; BinG = G), functor(G, F, A0), A is A0-1, G =.. [F|Args], tab(Out, 8), write(Out, 'return new '), (nonvar(P) -> write_package(P, Out), write(Out, '.') ; true), write_class_name(F/A, Out), write(Out, '('), write_reg_args(Args, Out), write(Out, ');'), nl(Out). write_java0(inline(G), In, Out) :- write_inline(G, In, Out), !. write_java0(new_hash(Tag,I), _, Out) :- !, tab(Out, 4), write(Out, 'static final java.util.HashMap '), (Tag == int -> write(Out, 'Int') ; write(Out, Tag)), write(Out, ' = new java.util.HashMap('), write(Out, I), write(Out, ');'), nl(Out). write_java0(put_hash(X,L,Tag), _, Out) :- !, tab(Out, 8), (Tag == int -> write(Out, 'Int') ; write(Out, Tag)), write(Out, '.put('), write_reg(X, Out), write(Out, ', '), write_index(L, Out), write(Out, ');'), nl(Out). write_java0(static(Instrs), In, Out) :- !, tab(Out, 4), write(Out, 'static {'), nl(Out), write_java0(Instrs, In, Out), tab(Out, 4), write(Out, '}'), nl(Out). %%% Put Instructions write_java0(put_var(X), _, Out) :- !, tab(Out, 8), write_reg(X, Out), write(Out, ' = new VariableTerm(engine);'), nl(Out). write_java0(put_int(I,X), _, Out) :- !, tab(Out, 4), write(Out, 'static final IntegerTerm '), write_reg(X, Out), write(Out, ' = new IntegerTerm('), (java_integer(I) -> true; write(Out, 'new java.math.BigInteger("')), write(Out, I), (java_integer(I) -> true; write(Out, '")')), write(Out, ');'), nl(Out). write_java0(put_float(F,X), _, Out) :- !, tab(Out, 4), write(Out, 'static final DoubleTerm '), write_reg(X, Out), write(Out, ' = new DoubleTerm('), write(Out, F), write(Out, ');'), nl(Out). write_java0(put_con(C,X), _, Out) :- !, tab(Out, 4), write(Out, 'static final SymbolTerm '), write_reg(X, Out), write(Out, ' = SymbolTerm.intern("'), (C = F/A -> write_constant(F, Out), write(Out, '", '), write(Out, A), write(Out, ');') ; write_constant(C, Out), write(Out, '");') ), nl(Out). write_java0(put_list(Xi,Xj,Xk), _, Out) :- !, (Xk = s(_) -> tab(Out, 4), write(Out, 'static final ListTerm ') ; tab(Out, 8) ), write_reg(Xk, Out), write(Out, ' = new ListTerm('), write_reg(Xi, Out), write(Out, ', '), write_reg(Xj, Out), write(Out, ');'), nl(Out). write_java0(put_str(Xi,Y,Xj), _, Out) :- !, (Xj = s(_) -> tab(Out, 4), write(Out, 'static final StructureTerm ') ; tab(Out, 8) ), write_reg(Xj, Out), write(Out, ' = new StructureTerm('), write_reg(Xi, Out), write(Out, ', '), write_reg(Y, Out), write(Out, ');'), nl(Out). write_java0(put_str_args(Xs,Y), _, Out) :- !, (Y = s(_) -> tab(Out, 4), write(Out, 'static final ') ; tab(Out, 8) ), write(Out, 'Term[] '), write_reg(Y, Out), write(Out, ' = {'), write_reg_args(Xs, Out), write(Out, '};'), nl(Out). write_java0(put_clo(G0, X), _, Out) :- !, (G0 = P:G -> true ; G0 = G), functor(G, F, A), G =.. [F|Args0], am2j_append(Args0, ['null'], Args), tab(Out, 8), write_reg(X, Out), write(Out, ' = new ClosureTerm(new '), (nonvar(P) -> write_package(P, Out), write(Out, '.') ; true), write_class_name(F/A, Out), write(Out, '('), write_reg_args(Args, Out), write(Out, '));'), nl(Out). %%% Get Instructions write_java0(get_val(Xi,Xj), _, Out) :- !, tab(Out, 8), write(Out, 'if (! '), write_reg(Xi, Out), write(Out, '.unify('), write_reg(Xj, Out), write(Out, ', engine.trail))'), nl(Out), tab(Out, 12), write(Out, 'return engine.fail();'), nl(Out). %write_java0(get_int(_,Xi,Xj), In, Out) :- !, % write_java0(get_val(Xi, Xj), In, Out). write_java0(get_int(N,Xi,Xj), In, Out) :- !, write_java0(deref(Xj,Xj), In, Out), % read mode tab(Out, 8), write(Out, 'if ('), write_reg(Xj, Out), write(Out, ' instanceof IntegerTerm){'), nl(Out), tab(Out, 12), write(Out, 'if (((IntegerTerm) '), write_reg(Xj, Out), write(Out, ').intValue() != '), write(Out, N), write(Out, ')'), nl(Out), tab(Out, 16), write(Out, 'return engine.fail();'), nl(Out), % write mode tab(Out, 8), write(Out, '} else if ('), write_reg(Xj, Out), write(Out, ' instanceof VariableTerm){'), nl(Out), tab(Out, 12), write(Out, '((VariableTerm) '), write_reg(Xj, Out), write(Out, ').bind('), write_reg(Xi, Out), write(Out, ', engine.trail);'), nl(Out), tab(Out, 8), % otherwise fail write(Out, '} else {'), nl(Out), tab(Out, 12), write(Out, 'return engine.fail();'), nl(Out), tab(Out, 8), write(Out, '}'), nl(Out). %write_java0(get_float(_,Xi,Xj), In, Out) :- !, % write_java0(get_val(Xi, Xj), In, Out). write_java0(get_float(N,Xi,Xj), In, Out) :- !, write_java0(deref(Xj,Xj), In, Out), % read mode tab(Out, 8), write(Out, 'if ('), write_reg(Xj, Out), write(Out, ' instanceof DoubleTerm)){'), nl(Out), tab(Out, 12), write(Out, 'if (((DoubleTerm) '), write_reg(Xj, Out), write(Out, ').doubleValue() != '), write(Out, N), write(Out, ')'), nl(Out), tab(Out, 16), write(Out, 'return engine.fail();'), nl(Out), % write mode tab(Out, 8), write(Out, '} else if ('), write_reg(Xj, Out), write(Out, ' instanceof VariableTerm){'), nl(Out), tab(Out, 12), write(Out, '((VariableTerm) '), write_reg(Xj, Out), write(Out, ').bind('), write_reg(Xi, Out), write(Out, ', engine.trail);'), nl(Out), tab(Out, 8), % otherwise fail write(Out, '} else {'), nl(Out), tab(Out, 12), write(Out, 'return engine.fail();'), nl(Out), tab(Out, 8), write(Out, '}'), nl(Out). %write_java0(get_con(_,Xi,Xj), In, Out) :- !, % write_java0(get_val(Xi, Xj), In, Out). write_java0(get_con(_,Xi,Xj), In, Out) :- !, write_java0(deref(Xj,Xj), In, Out), % read mode tab(Out, 8), write(Out, 'if ('), write_reg(Xj, Out), write(Out, ' instanceof SymbolTerm){'), nl(Out), tab(Out, 12), write(Out, 'if (! '), write_reg(Xj, Out), write(Out, '.equals('), write_reg(Xi, Out), write(Out, '))'), nl(Out), tab(Out, 16), write(Out, 'return engine.fail();'), nl(Out), % write mode tab(Out, 8), write(Out, '} else if ('), write_reg(Xj, Out), write(Out, ' instanceof VariableTerm){'), nl(Out), tab(Out, 12), write(Out, '((VariableTerm) '), write_reg(Xj, Out), write(Out, ').bind('), write_reg(Xi, Out), write(Out, ', engine.trail);'), nl(Out), tab(Out, 8), % otherwise fail write(Out, '} else {'), nl(Out), tab(Out, 12), write(Out, 'return engine.fail();'), nl(Out), tab(Out, 8), write(Out, '}'), nl(Out). write_java0(get_ground(_,Xi,Xj), In, Out) :- !, write_java0(get_val(Xi, Xj), In, Out). write_java0(get_list(X), In, Out) :- !, write_java0(deref(X,X), In, Out), read_instructions(2, In, Us), % read mode tab(Out, 8), write(Out, 'if ('), write_reg(X, Out), write(Out, ' instanceof ListTerm){'), nl(Out), tab(Out, 12), write(Out, 'Term[] args = {((ListTerm)'), write_reg(X, Out), write(Out, ').car(), ((ListTerm)'), write_reg(X, Out), write(Out, ').cdr()};'), nl(Out), write_unify_read(Us, 0, Out), % write mode tab(Out, 8), write(Out, '} else if ('), write_reg(X, Out), write(Out, ' instanceof VariableTerm){'), nl(Out), write_unify_write(Us, Rs, Out), tab(Out, 12), write(Out, '((VariableTerm) '), write_reg(X, Out), write(Out, ').bind(new ListTerm('), write_reg_args(Rs, Out), write(Out, '), engine.trail);'), nl(Out), % otherwise fail tab(Out, 8), write(Out, '} else {'), nl(Out), tab(Out, 12), write(Out, 'return engine.fail();'), nl(Out), tab(Out, 8), write(Out, '}'), nl(Out). write_java0(get_str(_F/A,Xi,Xj), In, Out) :- !, write_java0(deref(Xj,Xj), In, Out), read_instructions(A, In, Us), % read mode tab(Out, 8), write(Out, 'if ('), write_reg(Xj, Out), write(Out, ' instanceof StructureTerm){'), nl(Out), %??? == F tab(Out, 12), write(Out, 'if (! '), write_reg(Xi, Out), write(Out, '.equals(((StructureTerm)'), write_reg(Xj, Out), write(Out, ').functor()))'), nl(Out), tab(Out, 16), write(Out, 'return engine.fail();'), nl(Out), tab(Out, 12), write(Out, 'Term[] args = ((StructureTerm)'), write_reg(Xj, Out), write(Out, ').args();'), nl(Out), write_unify_read(Us, 0, Out), % write mode tab(Out, 8), write(Out, '} else if ('), write_reg(Xj, Out), write(Out, ' instanceof VariableTerm){'), nl(Out), write_unify_write(Us, Rs, Out), tab(Out, 12), write(Out, 'Term[] args = {'), write_reg_args(Rs, Out), write(Out, '};'), nl(Out), tab(Out, 12), write(Out, '((VariableTerm) '), write_reg(Xj, Out), write(Out, ').bind(new StructureTerm('), write_reg(Xi, Out), write(Out, ', args), engine.trail);'), nl(Out), % otherwise fail tab(Out, 8), write(Out, '} else {'), nl(Out), tab(Out, 12), write(Out, 'return engine.fail();'), nl(Out), tab(Out, 8), write(Out, '}'), nl(Out). %%% Choice Instructions write_java0(try(Li,Lj), _, Out) :- !, clause(current_arity(A), _), tab(Out, 8), write(Out, 'return engine.jtry'), write(Out, A), write(Out, '('), write_index(Li, Out), write(Out, ', '), write_index(Lj, Out), write(Out, ');'), nl(Out). write_java0(retry(Li,Lj), _, Out) :- !, tab(Out, 8), write(Out, 'return engine.retry('), write_index(Li, Out), write(Out, ', '), write_index(Lj, Out), write(Out, ');'), nl(Out). write_java0(trust(L), _, Out) :- !, tab(Out, 8), write(Out, 'return engine.trust('), write_index(L, Out), write(Out, ');'), nl(Out). %%% Indexing Instructions write_java0(switch_on_term(Lv,Li,Lf,Lc,Ls,Ll), _, Out) :- !, tab(Out, 8), write(Out, 'return engine.switch_on_term('), write_index(Lv, Out), write(Out, ', '), write_index(Li, Out), write(Out, ', '), write_index(Lf, Out), write(Out, ', '), write_index(Lc, Out), write(Out, ', '), write_index(Ls, Out), write(Out, ', '), write_index(Ll, Out), write(Out, ');'), nl(Out). write_java0(switch_on_hash(Tag,_,L, _), _, Out) :- !, tab(Out, 8), write(Out, 'return engine.switch_on_hash('), (Tag == int -> write(Out, 'Int') ; write(Out, Tag)), write(Out, ', '), write_index(L, Out), write(Out, ');'), nl(Out). write_java0(Instruction, _, _) :- am2j_error([Instruction,is,an,invalid,instruction]), fail. /***************************************************************** Write Label *****************************************************************/ write_label(main(F/A, Modifier), Out) :- !, % Import class constants within translation unit clause(current_package(P), _), nl(Out), write(Out, 'import static '), write_package(P, Out), write(Out, '.'), write_class_name(F/A, Out), write(Out, '.*;'), nl(Out), nl(Out), % Class definition (Modifier == (public) -> write(Out, 'public ') ; true), write(Out, 'final class '), write_class_name(F/A, Out), write(Out, ' extends '), write_predicate_base_class(A, Out), write(Out, ' {'), nl(Out). write_label(F/A, Out) :- !, % instance variable declaration (A > 4 -> nl(Out), write_enum('private final Term ', arg, 5, A, ', ', ';', 4, Out), nl(Out) ; true ), % constructor nl(Out), write_constructor(F/A, Out), nl(Out), % exec method nl(Out), tab(Out, 4), write(Out, '@Override'), nl(Out), tab(Out, 4), write(Out, 'public Operation exec(Prolog engine) {'), nl(Out). write_label(L, Out) :- tab(Out, 4), write(Out, '}'), nl(Out), write(Out, '}'), nl(Out), nl(Out), % class for control instructions and clauses write(Out, 'final class '), write_class_name(L, Out), write(Out, ' extends Operation {'), nl(Out), tab(Out, 4), write(Out, '@Override'), nl(Out), tab(Out, 4), write(Out, 'public Operation exec(Prolog engine) {'), nl(Out), !. write_label(Instruction, _, _) :- am2j_error([Instruction,is,an,invalid,instruction]), fail. /***************************************************************** Write Constructor *****************************************************************/ write_constructor(F/A, Out) :- tab(Out, 4), write(Out, 'public '), write_class_name(F/A, Out), write(Out, '('), (A > 0 -> write_enum('', 'Term a', 1, A, ', ', ', ', 0, Out) ; true ), write(Out, 'Operation cont) {'), nl(Out), A > 0, for(I, 1, A), tab(Out, 8), write(Out, 'this.'), write(Out, arg), write(Out, I), write(Out, ' = '), write(Out, a), write(Out, I), write(Out, ';'), nl(Out), fail. write_constructor(_, Out) :- tab(Out, 8), write(Out, 'this.cont = cont;'), nl(Out), tab(Out, 4), write(Out, '}'). write_enum(Head, Sym, SN, EN, Delim, _, Tab, Out) :- SN =< EN, tab(Out, Tab), write(Out, Head), for(I, SN, EN), write(Out, Sym), write(Out, I), (I < EN -> write(Out, Delim) ; true), fail. write_enum(_, _, SN, EN, _, Tail, _, Out) :- SN =< EN, write(Out, Tail). /***************************************************************** Write Unify Instructions *****************************************************************/ %%% Read Mode write_unify_read([], _, _) :- !. write_unify_read([unify_void(I)|Xs], N, Out) :- !, N1 is N+I, write_unify_read(Xs, N1, Out). write_unify_read([X|Xs], N, Out) :- write_unify_r(X, N, Out), N1 is N+1, write_unify_read(Xs, N1, Out). write_unify_r(X, _, _) :- var(X), !, am2j_error([unbound,variable,is,found]), fail. write_unify_r(unify_var(X), N, Out) :- !, tab(Out, 12), write_reg(X, Out), write(Out, ' = '), write_reg(args(N), Out), write(Out, ';'), nl(Out). write_unify_r(unify_val(X), N, Out) :- !, tab(Out, 12), write(Out, 'if (! '), write_reg(X, Out), write(Out, '.unify('), write_reg(args(N), Out), write(Out, ', engine.trail))'), nl(Out), tab(Out, 16), write(Out, 'return engine.fail();'), nl(Out). write_unify_r(unify_int(_,X), N, Out) :- !, %??? write_unify_r(unify_val(X), N, Out). write_unify_r(unify_float(_,X), N, Out) :- !, %??? write_unify_r(unify_val(X), N, Out). write_unify_r(unify_con(_,X), N, Out) :- !, %??? write_unify_r(unify_val(X), N, Out). write_unify_r(unify_ground(_,X), N, Out) :- !, write_unify_r(unify_val(X), N, Out). write_unify_r(X, _, _) :- am2j_error([X,is,an,invalid,instruction]), fail. %%% Write Mode write_unify_write([], [], _) :- !. write_unify_write([unify_void(0)|Xs], Rs, Out) :- !, write_unify_write(Xs, Rs, Out). write_unify_write([unify_void(I)|Xs], [void|Rs], Out) :- I > 0, !, I1 is I-1, write_unify_write([unify_void(I1)|Xs], Rs, Out). write_unify_write([X|Xs], [R|Rs], Out) :- write_unify_w(X, R, Out), write_unify_write(Xs, Rs, Out). write_unify_w(X, _, _) :- var(X), !, am2j_error([unbound,variable,is,found]), fail. write_unify_w(unify_var(X), X, Out) :- !, tab(Out, 12), write_reg(X, Out), write(Out, ' = new VariableTerm(engine);'), nl(Out). write_unify_w(unify_val(X), X, _) :- !. write_unify_w(unify_int(_,X), X, _) :- !. write_unify_w(unify_float(_,X), X, _) :- !. write_unify_w(unify_con(_,X), X, _) :- !. write_unify_w(unify_ground(_,X), X, _) :- !. write_unify_w(X, _, _) :- am2j_error([X,is,an,invalid,instruction]), fail. /***************************************************************** Write Inline *****************************************************************/ write_inline(X, In, Out) :- write_inline_start(X, Out), write_inline0(X, In, Out), write_inline_end(Out). write_inline_start(Goal, Out) :- tab(Out, 8), write(Out, '//START inline expansion of '), write(Out, Goal), nl(Out). write_inline_end(Out) :- tab(Out, 8), write(Out, '//END inline expansion'), nl(Out). % Control constructs write_inline0(fail, _, Out) :- !, tab(Out, 8), write(Out, 'return engine.fail();'), nl(Out). write_inline0('$get_level'(X), _, Out) :- !, write_if_fail(op('!', unify(X,#('new IntegerTerm'('engine.B0')))), [], 8, Out). write_inline0('$neck_cut', _, Out) :- !, tab(Out, 8), write(Out, 'engine.neckCut();'), nl(Out). write_inline0('$cut'(X), _, Out) :- !, write_deref_args([X], Out), tab(Out, 8), write(Out, 'if ('), write_reg(X, Out), write(Out, ' instanceof IntegerTerm) {'), nl(Out), tab(Out, 12), write(Out, 'engine.cut(((IntegerTerm) '), write_reg(X, Out), write(Out, ').intValue());'), nl(Out), tab(Out, 8), write(Out, '} else {'), nl(Out), tab(Out, 12), write(Out, 'throw new IllegalTypeException("integer", '), write_reg(X, Out), write(Out, ');'), nl(Out), tab(Out, 8), write(Out, '}'), nl(Out). % Term unification write_inline0('$unify'(X,Y), _, Out) :- !, write_if_fail(op('!', unify(X,Y)), [], 8, Out). write_inline0('$not_unifiable'(X,Y), _, Out) :- !, write_if_fail(unify(X,Y), [], 8, Out). % Type testing write_inline0(var(X), _, Out) :- !, write_if_fail(op('!', instanceof(X, 'VariableTerm')), [X], 8, Out). write_inline0(atom(X), _, Out) :- !, write_if_fail(op('!', instanceof(X, 'SymbolTerm')), [X], 8, Out). write_inline0(integer(X), _, Out) :- !, write_if_fail(op('!', instanceof(X, 'IntegerTerm')), [X], 8, Out). write_inline0(float(X), _, Out) :- !, write_if_fail(op('!', instanceof(X, 'DoubleTerm')), [X], 8, Out). write_inline0(nonvar(X), _, Out) :- !, write_if_fail(instanceof(X, 'VariableTerm'), [X], 8, Out). write_inline0(number(X), _, Out) :- !, NI = op('!', instanceof(X, 'IntegerTerm')), ND = op('!', instanceof(X, 'DoubleTerm')), write_if_fail(op('&&', NI, ND) , [X], 8, Out). write_inline0(java(X), _, Out) :- !, write_if_fail(op('!', instanceof(X, 'JavaObjectTerm')), [X], 8, Out). write_inline0(closure(X), _, Out) :- !, write_if_fail(op('!', instanceof(X, 'ClosureTerm')), [X], 8, Out). write_inline0(atomic(X), _, Out) :- !, NS = op('!', instanceof(X, 'SymbolTerm')), NI = op('!', instanceof(X, 'IntegerTerm')), ND = op('!', instanceof(X, 'DoubleTerm')), write_if_fail(op('&&', NS, op('&&', NI, ND)) , [X], 8, Out). write_inline0(java(X,Y), _, Out) :- !, write_if_fail(op('!', instanceof(X, 'JavaObjectTerm')), [X], 8, Out), EXP = #('SymbolTerm.create'(@(getName(@(getClass(@(object(cast('JavaObjectTerm',X))))))))), write_if_fail(op('!', unify(Y,EXP)), [], 8, Out). write_inline0(ground(X), _, Out) :- !, write_if_fail(op('!', @('isGround'(X))), [X], 8, Out). % Term comparison write_inline0('$equality_of_term'(X,Y), _, Out) :- !, write_if_fail(op('!',@('equals'(X,Y))), [X,Y], 8, Out). write_inline0('$inequality_of_term'(X,Y), _, Out) :- !, write_if_fail(@('equals'(X,Y)), [X,Y], 8, Out). write_inline0('$after'(X,Y), _, Out) :- !, write_if_fail(op('<=',@('compareTo'(X,Y)),0), [X,Y], 8, Out). write_inline0('$before'(X,Y), _, Out) :- !, write_if_fail(op('>=',@('compareTo'(X,Y)),0), [X,Y], 8, Out). write_inline0('$not_after'(X,Y), _, Out) :- !, write_if_fail(op('>', @('compareTo'(X,Y)),0), [X,Y], 8, Out). write_inline0('$not_before'(X,Y), _, Out) :- !, write_if_fail(op('<', @('compareTo'(X,Y)),0), [X,Y], 8, Out). write_inline0('$identical_or_cannot_unify'(X,Y), _, Out) :- !, write_if_fail(op('&&', op('!',@('equals'(X,Y))), unify(X,Y)), [X,Y], 8, Out). % Term creation and decomposition write_inline0(copy_term(X,Y), _, Out) :- nonvar(X), nonvar(Y), !, write_if_fail(op('!', unify(Y, #('engine.copy'(X)))), [X], 8, Out). % Arithmetic evaluation write_inline0(is(X,Y), _, Out) :- !, write_arith(_, Y, X, 8, Out). write_inline0('$abs'(X,Y), _, Out) :- !, write_arith('abs', X, Y, 8, Out). write_inline0('$asin'(X,Y), _, Out) :- !, write_arith('asin', X, Y, 8, Out). write_inline0('$acos'(X,Y), _, Out) :- !, write_arith('acos', X, Y, 8, Out). write_inline0('$atan'(X,Y), _, Out) :- !, write_arith('atan', X, Y, 8, Out). write_inline0('$bitwise_conj'(X,Y,Z), _, Out) :- !, write_arith('and', X, Y, Z, 8, Out). write_inline0('$bitwise_disj'(X,Y,Z), _, Out) :- !, write_arith('or', X, Y, Z, 8, Out). write_inline0('$bitwise_exclusive_or'(X,Y,Z), _, Out) :- !, write_arith('xor', X, Y, Z, 8, Out). write_inline0('$bitwise_neg'(X,Y), _, Out) :- !, write_arith('not', X, Y, 8, Out). write_inline0('$ceil'(X,Y), _, Out) :- !, write_arith('ceil', X, Y, 8, Out). write_inline0('$cos'(X,Y), _, Out) :- !, write_arith('cos', X, Y, 8, Out). write_inline0('$degrees'(X,Y), _, Out) :- !, write_arith('toDegrees', X, Y, 8, Out). write_inline0('$exp'(X,Y), _, Out) :- !, write_arith('exp', X, Y, 8, Out). write_inline0('$float'(X,Y), _, Out) :- !, write_arith('toFloat', X, Y, 8, Out). write_inline0('$float_integer_part'(X,Y), _, Out) :- !, write_arith('floatIntPart', X, Y, 8, Out). write_inline0('$float_fractional_part'(X,Y), _, Out) :- !, write_arith('floatFractPart', X, Y, 8, Out). write_inline0('$float_quotient'(X,Y,Z), _, Out) :- !, write_arith('divide', X, Y, Z, 8, Out). write_inline0('$floor'(X,Y), _, Out) :- !, write_arith('floor', X, Y, 8, Out). write_inline0('$int_quotient'(X,Y,Z), _, Out) :- !, write_arith('intDivide', X, Y, Z, 8, Out). write_inline0('$log'(X,Y), _, Out) :- !, write_arith('log', X, Y, 8, Out). write_inline0('$max'(X,Y,Z), _, Out) :- !, write_arith('max', X, Y, Z, 8, Out). write_inline0('$min'(X,Y,Z), _, Out) :- !, write_arith('min', X, Y, Z, 8, Out). write_inline0('$minus'(X,Y,Z), _, Out) :- !, write_arith('subtract', X, Y, Z, 8, Out). write_inline0('$mod'(X,Y,Z), _, Out) :- !, write_arith('mod', X, Y, Z, 8, Out). write_inline0('$multi'(X,Y,Z), _, Out) :- !, write_arith('multiply', X, Y, Z, 8, Out). write_inline0('$plus'(X,Y,Z), _, Out) :- !, write_arith('add', X, Y, Z, 8, Out). write_inline0('$pow'(X,Y,Z), _, Out) :- !, write_arith('pow', X, Y, Z, 8, Out). write_inline0('$radians'(X,Y), _, Out) :- !, write_arith('toRadians', X, Y, 8, Out). write_inline0('$rint'(X,Y), _, Out) :- !, write_arith('rint', X, Y, 8, Out). write_inline0('$round'(X,Y), _, Out) :- !, write_arith('round', X, Y, 8, Out). write_inline0('$shift_left'(X,Y,Z), _, Out) :- !, write_arith('shiftLeft', X, Y, Z, 8, Out). write_inline0('$shift_right'(X,Y,Z), _, Out) :- !, write_arith('shiftRight', X, Y, Z, 8, Out). write_inline0('$sign'(X,Y), _, Out) :- !, write_arith('signum', X, Y, 8, Out). write_inline0('$sin'(X,Y), _, Out) :- !, write_arith('sin', X, Y, 8, Out). write_inline0('$sqrt'(X,Y), _, Out) :- !, write_arith('sqrt', X, Y, 8, Out). write_inline0('$tan'(X,Y), _, Out) :- !, write_arith('tan', X, Y, 8, Out). write_inline0('$truncate'(X,Y), _, Out) :- !, write_arith('truncate', X, Y, 8, Out). % Arithmetic comparison write_inline0('$arith_equal'(X,Y), _, Out) :- !, write_arith_compare('!=', X, Y, 8, Out). write_inline0('$arith_not_equal'(X,Y), _, Out) :- !, write_arith_compare('==', X, Y, 8, Out). write_inline0('$greater_or_equal'(X,Y), _, Out) :- !, write_arith_compare('<', X, Y, 8, Out). write_inline0('$greater_than'(X,Y), _, Out) :- !, write_arith_compare('<=', X, Y, 8, Out). write_inline0('$less_or_equal'(X,Y), _, Out) :- !, write_arith_compare('>', X, Y, 8, Out). write_inline0('$less_than'(X,Y), _, Out) :- !, write_arith_compare('>=', X, Y, 8, Out). write_deref_args([], _) :- !. write_deref_args([s(_)|Xs], Out) :- !, write_deref_args(Xs, Out). write_deref_args([si(_)|Xs], Out) :- !, % ??? write_deref_args(Xs, Out). write_deref_args([sf(_)|Xs], Out) :- !, % ??? write_deref_args(Xs, Out). write_deref_args([X|Xs], Out) :- write_java0(deref(X,X), _, Out), write_deref_args(Xs, Out). write_if_fail(Cond, Args, Tab, Out) :- nonvar(Cond), ground(Args), !, EXP = if_then(Cond, 'return engine.fail()'), write_deref_args(Args, Out), write_inline_java(EXP, Tab, Out). make_arith_arg(E, _) :- var(E), !, fail. make_arith_arg(E, E) :- E = si(_), !. make_arith_arg(E, E) :- E = sf(_), !. %make_arith_arg(E, cast('NumberTerm',E)) :- E = a(_), !. %??? make_arith_arg(E, #('Arithmetic.evaluate'(E))). write_arith(M, E, V, Tab, Out) :- make_arith_arg(E, A1), nonvar(V), ( nonvar(M) -> A0 =.. [M,A1], A = @(A0) ; A = A1 ), EXP = try_catch(SENT, 'BuiltinException', ['e.goal = this','throw e']), SENT = if_then(op('!', unify(V,A)), 'return engine.fail()'), %write_deref_args([E], Out), write_inline_java(EXP, Tab, Out). write_arith(M, E1, E2, V, Tab, Out) :- nonvar(M), make_arith_arg(E1, A1), make_arith_arg(E2, A2), nonvar(V), A0 =.. [M,A1,A2], A = @(A0), EXP = try_catch(SENT, 'BuiltinException', ['e.goal = this','throw e']), SENT = if_then(op('!', unify(V,A)), 'return engine.fail()'), %write_deref_args([E1,E2], Out), write_inline_java(EXP, Tab, Out). write_arith_compare(M, E1, E2, Tab, Out) :- nonvar(M), make_arith_arg(E1, A1), make_arith_arg(E2, A2), A0 =.. ['arithCompareTo',A1,A2], A = @(A0), EXP = try_catch(SENT, 'BuiltinException', ['e.goal = this','throw e']), SENT = if_then(op(M, A, 0), 'return engine.fail()'), %write_deref_args([E1,E2], Out), write_inline_java(EXP, Tab, Out). write_inline_java(X, _, _) :- var(X), !, fail. write_inline_java([], _, _) :- !. write_inline_java([X|Xs], Tab, Out) :- !, write_inline_java(X, Tab, Out), write_inline_java(Xs, Tab, Out). write_inline_java(try_catch(TRY,EXCEPT,CATCH), Tab, Out) :- !, tab(Out, Tab), write(Out, 'try {'), nl(Out), Tab1 is Tab + 4, write_inline_java(TRY, Tab1, Out), tab(Out, Tab), write(Out, '} catch ('), write(Out, EXCEPT), write(Out, ' e) {'), nl(Out), write_inline_java(CATCH, Tab1, Out), tab(Out, Tab), write(Out, '}'), nl(Out). write_inline_java(if_then(IF, THEN), Tab, Out) :- !, tab(Out, Tab), write(Out, 'if ('), write_inline_exp(IF, 0, Out), write(Out, ') {'), nl(Out), Tab1 is Tab + 4, write_inline_java(THEN, Tab1, Out), tab(Out, Tab), write(Out, '}'), nl(Out). write_inline_java(if_then_else(IF, THEN, ELSE), Tab, Out) :- !, tab(Out, Tab), write(Out, 'if ('), write_inline_exp(IF, 0, Out), write(Out, ') {'), nl(Out), Tab1 is Tab + 4, write_inline_java(THEN, Tab1, Out), tab(Out, Tab), write(Out, '} else {'), nl(Out), write_inline_java(ELSE, Tab1, Out), tab(Out, Tab), write(Out, '}'), nl(Out). write_inline_java(X, Tab, Out) :- tab(Out, Tab), write(Out, X), write(Out, ';'), nl(Out). write_inline_exp(X, _, _) :- var(X), !, fail. write_inline_exp([], _, _) :- !. write_inline_exp([X], Tab, Out) :- !, write_inline_exp(X, Tab, Out). write_inline_exp([X|Xs], Tab, Out) :- !, write_inline_exp(X, Tab, Out), write(Out, ','), write_inline_exp(Xs, 0, Out). write_inline_exp(bracket(Exp), Tab, Out) :- !, tab(Out, Tab), write(Out, '('), write_inline_exp(Exp, 0, Out), write(Out, ')'). write_inline_exp(op(Op, Exp), Tab, Out) :- !, tab(Out, Tab), write(Out, Op), write(Out, ' '), write_inline_exp(Exp, 0, Out). write_inline_exp(op(Op, Exp1, Exp2), Tab, Out) :- !, tab(Out, Tab), write_inline_exp(Exp1, 0, Out), write(Out, ' '), write(Out, Op), write(Out, ' '), write_inline_exp(Exp2, 0, Out). write_inline_exp(instanceof(Exp,Class), Tab, Out) :- !, tab(Out, Tab), write(Out, '('), write_inline_exp(Exp, 0, Out), write(Out, ' instanceof '), write(Out, Class), write(Out, ')'). write_inline_exp(cast(Class,Exp), Tab, Out) :- !, tab(Out, Tab), write(Out, '(('), write(Out, Class), write(Out, ') '), write_inline_exp(Exp, 0, Out), write(Out, ')'). write_inline_exp(unify(X,Y), Tab, Out) :- !, tab(Out, Tab), write_inline_exp(X, 0, Out), write(Out, '.unify('), write_inline_exp(Y, 0, Out), write(Out, ', engine.trail)'). write_inline_exp(#(X), Tab, Out) :- !, X =.. [F|As], tab(Out, Tab), write(Out, F), write(Out, '('), write_inline_exp(As, 0, Out), write(Out, ')'). write_inline_exp(@(X), Tab, Out) :- !, X =.. [F|As], write_inline_method(F, As, Tab, Out). write_inline_exp(X, Tab, Out) :- X = s(_), !, tab(Out, Tab), write_reg(X, Out). write_inline_exp(X, Tab, Out) :- X = si(_), !, % ??? tab(Out, Tab), write_reg(X, Out). write_inline_exp(X, Tab, Out) :- X = sf(_), !, % ??? tab(Out, Tab), write_reg(X, Out). write_inline_exp(X, Tab, Out) :- X = a(_), !, tab(Out, Tab), write_reg(X, Out). write_inline_exp(X, Tab, Out) :- X == void, !, % ??? tab(Out, Tab), write_reg(X, Out). write_inline_exp(X, Tab, Out) :- tab(Out, Tab), write(Out, X). write_inline_method(F, _, _, _) :- var(F), !, fail. write_inline_method(_, A, _, _) :- var(A), !, fail. write_inline_method(F, [A], Tab, Out) :- !, tab(Out, Tab), write_inline_exp(A, 0, Out), write(Out, '.'), write(Out, F), write(Out, '()'). write_inline_method(F, [A,B], Tab, Out) :- tab(Out, Tab), write_inline_exp(A, 0, Out), write(Out, '.'), write(Out, F), write(Out, '('), write_inline_exp(B, 0, Out), write(Out, ')'). /***************************************************************** Write Insert *****************************************************************/ write_insert(X, _, _) :- var(X), !, fail. write_insert([], _, _) :- !. write_insert([X|Xs], _, Out) :- atom(X), write(Out, X), nl(Out), write_insert(Xs, _, Out). /***************************************************************** Auxiliaries *****************************************************************/ % Create a directory if missing mkdirs(Dir) :- exists_directory(Dir), !. mkdirs(Dir) :- file_directory_name(Dir, Parent), mkdirs(Parent), make_directory(Dir). % int java_integer(X) :- integer(X), -2147483648 =< X, X =< 2147483647. % Read Instructions read_instructions(0, _, []) :- !. read_instructions(N, In, [X|Xs]) :- N > 0, read(In, X), N1 is N-1, read_instructions(N1, In, Xs). % Write package name write_package(P, Out) :- !, write(Out, P). % Write class name write_class_name(L, Out) :- write(Out, 'PRED_'), write_index(L, Out). % Write out base class name write_predicate_base_class(0, Out) :- !, write(Out, 'Predicate'). write_predicate_base_class(1, Out) :- !, write(Out, 'Predicate.P1'). write_predicate_base_class(2, Out) :- !, write(Out, 'Predicate.P2'). write_predicate_base_class(3, Out) :- !, write(Out, 'Predicate.P3'). write_predicate_base_class(4, Out) :- !, write(Out, 'Predicate.P4'). write_predicate_base_class(_, Out) :- !, write(Out, 'Predicate.P4'). % Write label write_index(F/A, Out) :- !, write_pred_spec(F/A, Out). write_index(L+I, Out) :- write_index(L, Out), write(Out, '_'), write(Out, I). % Write constant name write_constant(X, Out) :- constant_encoding(X, Y), write(Out, Y). % Write predicate specification write_pred_spec(F/A, Out) :- predicate_encoding(F, F1), write(Out, F1), write(Out, '_'), write(Out, A). % Package name as directory package_encoding(P, Dir) :- atom_codes(P, Chs0), package_encoding(Chs0, Chs, []), atom_codes(Dir, Chs). package_encoding([]) --> !. package_encoding([46|Xs]) --> !, [47], package_encoding(Xs). package_encoding([X|Xs]) --> !, [X] , package_encoding(Xs). % Predicate Encoding predicate_encoding(X, Y) :- atom_codes(X, Chs0), pred_encoding(Chs0, Chs, []), atom_codes(Y, Chs). pred_encoding([]) --> !. pred_encoding([X|Xs]) --> pred_encoding_char(X), pred_encoding(Xs). pred_encoding_char(X) --> {97 =< X, X =< 122}, !, [X]. % a..z pred_encoding_char(X) --> {65 =< X, X =< 90}, !, [X]. % A..Z pred_encoding_char(X) --> {48 =< X, X =< 57}, !, [X]. % 0..9 pred_encoding_char(95) --> !, [95]. % '_' pred_encoding_char(36) --> !, [36]. % '$' ??? pred_encoding_char(X) --> {0 =< X, X =< 65535}, !, [36], % '$' pred_encoding_hex(X). pred_encoding_char(X) --> {am2j_error([X,is,an,invalid,character,code]), fail}. pred_encoding_hex(X) --> {int_to_hex(X, [], H)}, pred_encoding_hex_char(H). pred_encoding_hex_char([]) --> !, [48,48,48,48]. % 0000 pred_encoding_hex_char([X]) --> !, [48,48,48, X]. % 000X pred_encoding_hex_char([X,Y]) --> !, [48,48, X, Y]. % 00XY pred_encoding_hex_char([X,Y,Z]) --> !, [48, X, Y, Z]. % 0XYZ pred_encoding_hex_char([X,Y,Z,W]) --> !, [ X, Y, Z, W]. % XYZW int_to_hex(0, H, H) :- !. int_to_hex(D, H0, H) :- R is D mod 16, D1 is D//16, hex_map(R, R1), int_to_hex(D1, [R1|H0], H). hex_map(10, 65) :- !. % 'A' hex_map(11, 66) :- !. % 'B' hex_map(12, 67) :- !. % 'C' hex_map(13, 68) :- !. % 'D' hex_map(14, 69) :- !. % 'E' hex_map(15, 70) :- !. % 'F' hex_map(X, Y) :- 0 =< X, X =< 9, number_codes(X, [Y]). % Constant Encoding (especially, escape sequence) constant_encoding(X, Y) :- atom_codes(X, Chs0), con_encoding(Chs0, Chs), %??? atom_codes(Y, Chs). con_encoding([], []) :- !. con_encoding([ 7|Xs], [92, 97|Ys]):- !, con_encoding(Xs, Ys). % \a con_encoding([ 8|Xs], [92, 98|Ys]):- !, con_encoding(Xs, Ys). % \b con_encoding([ 9|Xs], [92,116|Ys]):- !, con_encoding(Xs, Ys). % \t con_encoding([10|Xs], [92,110|Ys]):- !, con_encoding(Xs, Ys). % \n con_encoding([11|Xs], [92,118|Ys]):- !, con_encoding(Xs, Ys). % \v con_encoding([12|Xs], [92,102|Ys]):- !, con_encoding(Xs, Ys). % \f con_encoding([13|Xs], [92,114|Ys]):- !, con_encoding(Xs, Ys). % \r con_encoding([34|Xs], [92, 34|Ys]):- !, con_encoding(Xs, Ys). % \" - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - src/compiler/am2j.pl [1:1089]: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - /***************************************************************** Time-stamp: <2008-10-29 10:42:42 banbara> NAME am2j: Translating WAM-based Intermediate Code into Java USAGE # sicstus ?- [am2j]. ?- am2j([File]). # sicstus ?- [am2j]. ?- am2j([File, Dir]). PARAMETERS File is an input WAM-based Intermediate file name. DESCRIPTION This program translates WAM-based intermediate codes into Java. For each predicate p/n, the file named "PRED_p_n.java" is generated. Generated files can be compiled and executed by usual java utilities (ex. javac) with the Prolog Cafe runtime system. COPYRIGHT am2j (Translating WAM-based Intermediate Code into Java) Copyright (C) 1997-2008 by Mutsunori Banbara (banbara@kobe-u.ac.jp) and Naoyuki Tamura (tamura@kobe-u.ac.jp) SEE ALSO http://kaminari.istc.kobe-u.ac.jp/PrologCafe/ *****************************************************************/ /***************************************************************** Declarations *****************************************************************/ :- op(1170, xfx, (:-)). :- op(1170, xfx, (-->)). :- op(1170, fx, (:-)). :- op(1170, fx, (?-)). :- op(1150, fx, (public)). :- op(1150, fx, (package)). % Prolog Cafe specific :- dynamic dest_dir/1. :- dynamic current_arity/1. :- dynamic current_package/1. % :- module('com.googlecode.prolog_cafe.compiler.am2j', [main/0,am2j/1]). package(_). :- package 'com.googlecode.prolog_cafe.compiler.am2j'. :- public am2j/1. /***************************************************************** Main *****************************************************************/ am2j([File]) :- !, am2j([File, '.']). am2j([File,Dir]) :- retractall(dest_dir(_)), assert(dest_dir(Dir)), open(File, read, In), repeat, read(In, X), write_java(X, In), X == end_of_file, !, close(In). write_java(X, _) :- var(X), !, am2j_error([unbound,variable,is,found]), fail. write_java(end_of_file, _) :- !. write_java((:- G), _) :- !, call(G). write_java(begin_predicate(P, F/A), In) :- clause(dest_dir(Dir), _), retractall(current_package(_)), retractall(current_arity(_)), assert(current_package(P)), assert(current_arity(A)), predicate_encoding(F, F1), package_encoding(P, PDir), list_to_string([Dir,'/',PDir], SrcDir), list_to_string([SrcDir,'/','PRED_',F1,'_',A,'.java'], SrcFile), mkdirs(SrcDir), open(SrcFile, write, Out), write(Out, 'package '), write_package(P, Out), write(Out, ';'), nl(Out), repeat, read(In, X), write_java0(X, In, Out), X == end_predicate(P, F/A), close(Out), !. write_java(X, _) :- am2j_error([X,is,an,invalid,argument,in,write_java/2]), fail. /***************************************************************** Write Java *****************************************************************/ write_java0(X, _, _) :- var(X), !, am2j_error([unbound,variable,is,found]), fail. write_java0([], _, _) :- !. write_java0([X|Xs], In, Out) :- !, write_java0(X, In, Out), write_java0(Xs, In, Out). write_java0(end_predicate(_, _), _, Out) :- !, tab(Out, 4), write(Out, '}'), nl(Out), write(Out, '}'), nl(Out). write_java0(comment(Comment), _, Out) :- !, numbervars(Comment, 0, _), tab(Out, 4), write(Out, '// '), writeq(Out, Comment), nl(Out). write_java0(debug(Comment), _, Out) :- !, numbervars(Comment, 0, _), write(Out, '// '), writeq(Out, Comment), nl(Out). write_java0(info([FA,File|_]), _, Out) :- !, write(Out, '/*'), nl(Out), write(Out, ' '), writeq(Out, FA), write(Out, ' defined in '), write(Out, File), nl(Out), write(Out, ' This file is generated by Prolog Cafe.'), nl(Out), write(Out, ' PLEASE DO NOT EDIT!'), nl(Out), write(Out, '*/'), nl(Out). write_java0(import_package(P), _, Out) :- !, write(Out, 'import '), write_package(P, Out), write(Out, '.*;'), nl(Out). write_java0(import_static(P,F), _, Out) :- !, write(Out, 'import static '), write_package(P, Out), write(Out, '.'), write(Out, F), write(Out, ';'), nl(Out). write_java0(import_package(P,FA), _, Out) :- !, write(Out, 'import '), write_package(P, Out), write(Out, '.'), (FA = _/_ -> write_class_name(FA, Out) ; write_package(FA, Out) ), write(Out, ';'), nl(Out). write_java0((Label: Instruction), In, Out) :- !, write_label(Label, Out), write_java0(Instruction, In, Out). write_java0(label(L), _, Out) :- !, tab(Out, 4), write(Out, 'static final Operation '), write_index(L, Out), write(Out, ' = new '), write_class_name(L, Out), write(Out, '();'), nl(Out). write_java0(goto(L), _, Out) :- !, tab(Out, 8), write(Out, 'return '), write_index(L, Out), write(Out, ';'), nl(Out). write_java0(setB0, _, Out) :- !, tab(Out, 8), write(Out, 'engine.setB0();'), nl(Out). write_java0(deref(_,void), _, _) :- !. write_java0(deref(Ri,Rj), _, Out) :- !, tab(Out, 8), write_reg(Rj, Out), write(Out, ' = '), write_reg(Ri, Out), write(Out, '.dereference();'), nl(Out). write_java0(set(_,void), _, _) :- !. write_java0(set(Ri,Rj), _, Out) :- !, tab(Out, 8), write_reg(Rj, Out), write(Out, ' = '), write_reg(Ri, Out), write(Out, ';'), nl(Out). write_java0(decl_term_vars([]), _, _) :- !. write_java0(decl_term_vars(L), _, Out) :- !, tab(Out, 8), write(Out, 'Term '), write_reg_args(L, Out), write(Out, ';'), nl(Out). write_java0(decl_pred_vars([]), _, _) :- !. write_java0(decl_pred_vars(L), _, Out) :- !, tab(Out, 8), write(Out, 'Operation '), write_reg_args(L, Out), write(Out, ';'), nl(Out). write_java0(put_cont(BinG,C), _, Out) :- !, (BinG = P:G -> true ; BinG = G), functor(G, F, A0), A is A0-1, G =.. [F|Args], tab(Out, 8), write_reg(C, Out), write(Out, ' = new '), (nonvar(P) -> write_package(P, Out), write(Out, '.') ; true), write_class_name(F/A, Out), write(Out, '('), write_reg_args(Args, Out), write(Out, ');'), nl(Out). write_java0(execute(cont), _, Out) :- !, tab(Out, 8), write(Out, 'return cont;'), nl(Out). write_java0(execute(BinG), _, Out) :- !, (BinG = P:G -> true ; BinG = G), functor(G, F, A0), A is A0-1, G =.. [F|Args], tab(Out, 8), write(Out, 'return new '), (nonvar(P) -> write_package(P, Out), write(Out, '.') ; true), write_class_name(F/A, Out), write(Out, '('), write_reg_args(Args, Out), write(Out, ');'), nl(Out). write_java0(inline(G), In, Out) :- write_inline(G, In, Out), !. write_java0(new_hash(Tag,I), _, Out) :- !, tab(Out, 4), write(Out, 'static final java.util.HashMap '), (Tag == int -> write(Out, 'Int') ; write(Out, Tag)), write(Out, ' = new java.util.HashMap('), write(Out, I), write(Out, ');'), nl(Out). write_java0(put_hash(X,L,Tag), _, Out) :- !, tab(Out, 8), (Tag == int -> write(Out, 'Int') ; write(Out, Tag)), write(Out, '.put('), write_reg(X, Out), write(Out, ', '), write_index(L, Out), write(Out, ');'), nl(Out). write_java0(static(Instrs), In, Out) :- !, tab(Out, 4), write(Out, 'static {'), nl(Out), write_java0(Instrs, In, Out), tab(Out, 4), write(Out, '}'), nl(Out). %%% Put Instructions write_java0(put_var(X), _, Out) :- !, tab(Out, 8), write_reg(X, Out), write(Out, ' = new VariableTerm(engine);'), nl(Out). write_java0(put_int(I,X), _, Out) :- !, tab(Out, 4), write(Out, 'static final IntegerTerm '), write_reg(X, Out), write(Out, ' = new IntegerTerm('), (java_integer(I) -> true; write(Out, 'new java.math.BigInteger("')), write(Out, I), (java_integer(I) -> true; write(Out, '")')), write(Out, ');'), nl(Out). write_java0(put_float(F,X), _, Out) :- !, tab(Out, 4), write(Out, 'static final DoubleTerm '), write_reg(X, Out), write(Out, ' = new DoubleTerm('), write(Out, F), write(Out, ');'), nl(Out). write_java0(put_con(C,X), _, Out) :- !, tab(Out, 4), write(Out, 'static final SymbolTerm '), write_reg(X, Out), write(Out, ' = SymbolTerm.intern("'), (C = F/A -> write_constant(F, Out), write(Out, '", '), write(Out, A), write(Out, ');') ; write_constant(C, Out), write(Out, '");') ), nl(Out). write_java0(put_list(Xi,Xj,Xk), _, Out) :- !, (Xk = s(_) -> tab(Out, 4), write(Out, 'static final ListTerm ') ; tab(Out, 8) ), write_reg(Xk, Out), write(Out, ' = new ListTerm('), write_reg(Xi, Out), write(Out, ', '), write_reg(Xj, Out), write(Out, ');'), nl(Out). write_java0(put_str(Xi,Y,Xj), _, Out) :- !, (Xj = s(_) -> tab(Out, 4), write(Out, 'static final StructureTerm ') ; tab(Out, 8) ), write_reg(Xj, Out), write(Out, ' = new StructureTerm('), write_reg(Xi, Out), write(Out, ', '), write_reg(Y, Out), write(Out, ');'), nl(Out). write_java0(put_str_args(Xs,Y), _, Out) :- !, (Y = s(_) -> tab(Out, 4), write(Out, 'static final ') ; tab(Out, 8) ), write(Out, 'Term[] '), write_reg(Y, Out), write(Out, ' = {'), write_reg_args(Xs, Out), write(Out, '};'), nl(Out). write_java0(put_clo(G0, X), _, Out) :- !, (G0 = P:G -> true ; G0 = G), functor(G, F, A), G =.. [F|Args0], am2j_append(Args0, ['null'], Args), tab(Out, 8), write_reg(X, Out), write(Out, ' = new ClosureTerm(new '), (nonvar(P) -> write_package(P, Out), write(Out, '.') ; true), write_class_name(F/A, Out), write(Out, '('), write_reg_args(Args, Out), write(Out, '));'), nl(Out). %%% Get Instructions write_java0(get_val(Xi,Xj), _, Out) :- !, tab(Out, 8), write(Out, 'if (! '), write_reg(Xi, Out), write(Out, '.unify('), write_reg(Xj, Out), write(Out, ', engine.trail))'), nl(Out), tab(Out, 12), write(Out, 'return engine.fail();'), nl(Out). %write_java0(get_int(_,Xi,Xj), In, Out) :- !, % write_java0(get_val(Xi, Xj), In, Out). write_java0(get_int(N,Xi,Xj), In, Out) :- !, write_java0(deref(Xj,Xj), In, Out), % read mode tab(Out, 8), write(Out, 'if ('), write_reg(Xj, Out), write(Out, ' instanceof IntegerTerm){'), nl(Out), tab(Out, 12), write(Out, 'if (((IntegerTerm) '), write_reg(Xj, Out), write(Out, ').intValue() != '), write(Out, N), write(Out, ')'), nl(Out), tab(Out, 16), write(Out, 'return engine.fail();'), nl(Out), % write mode tab(Out, 8), write(Out, '} else if ('), write_reg(Xj, Out), write(Out, ' instanceof VariableTerm){'), nl(Out), tab(Out, 12), write(Out, '((VariableTerm) '), write_reg(Xj, Out), write(Out, ').bind('), write_reg(Xi, Out), write(Out, ', engine.trail);'), nl(Out), tab(Out, 8), % otherwise fail write(Out, '} else {'), nl(Out), tab(Out, 12), write(Out, 'return engine.fail();'), nl(Out), tab(Out, 8), write(Out, '}'), nl(Out). %write_java0(get_float(_,Xi,Xj), In, Out) :- !, % write_java0(get_val(Xi, Xj), In, Out). write_java0(get_float(N,Xi,Xj), In, Out) :- !, write_java0(deref(Xj,Xj), In, Out), % read mode tab(Out, 8), write(Out, 'if ('), write_reg(Xj, Out), write(Out, ' instanceof DoubleTerm)){'), nl(Out), tab(Out, 12), write(Out, 'if (((DoubleTerm) '), write_reg(Xj, Out), write(Out, ').doubleValue() != '), write(Out, N), write(Out, ')'), nl(Out), tab(Out, 16), write(Out, 'return engine.fail();'), nl(Out), % write mode tab(Out, 8), write(Out, '} else if ('), write_reg(Xj, Out), write(Out, ' instanceof VariableTerm){'), nl(Out), tab(Out, 12), write(Out, '((VariableTerm) '), write_reg(Xj, Out), write(Out, ').bind('), write_reg(Xi, Out), write(Out, ', engine.trail);'), nl(Out), tab(Out, 8), % otherwise fail write(Out, '} else {'), nl(Out), tab(Out, 12), write(Out, 'return engine.fail();'), nl(Out), tab(Out, 8), write(Out, '}'), nl(Out). %write_java0(get_con(_,Xi,Xj), In, Out) :- !, % write_java0(get_val(Xi, Xj), In, Out). write_java0(get_con(_,Xi,Xj), In, Out) :- !, write_java0(deref(Xj,Xj), In, Out), % read mode tab(Out, 8), write(Out, 'if ('), write_reg(Xj, Out), write(Out, ' instanceof SymbolTerm){'), nl(Out), tab(Out, 12), write(Out, 'if (! '), write_reg(Xj, Out), write(Out, '.equals('), write_reg(Xi, Out), write(Out, '))'), nl(Out), tab(Out, 16), write(Out, 'return engine.fail();'), nl(Out), % write mode tab(Out, 8), write(Out, '} else if ('), write_reg(Xj, Out), write(Out, ' instanceof VariableTerm){'), nl(Out), tab(Out, 12), write(Out, '((VariableTerm) '), write_reg(Xj, Out), write(Out, ').bind('), write_reg(Xi, Out), write(Out, ', engine.trail);'), nl(Out), tab(Out, 8), % otherwise fail write(Out, '} else {'), nl(Out), tab(Out, 12), write(Out, 'return engine.fail();'), nl(Out), tab(Out, 8), write(Out, '}'), nl(Out). write_java0(get_ground(_,Xi,Xj), In, Out) :- !, write_java0(get_val(Xi, Xj), In, Out). write_java0(get_list(X), In, Out) :- !, write_java0(deref(X,X), In, Out), read_instructions(2, In, Us), % read mode tab(Out, 8), write(Out, 'if ('), write_reg(X, Out), write(Out, ' instanceof ListTerm){'), nl(Out), tab(Out, 12), write(Out, 'Term[] args = {((ListTerm)'), write_reg(X, Out), write(Out, ').car(), ((ListTerm)'), write_reg(X, Out), write(Out, ').cdr()};'), nl(Out), write_unify_read(Us, 0, Out), % write mode tab(Out, 8), write(Out, '} else if ('), write_reg(X, Out), write(Out, ' instanceof VariableTerm){'), nl(Out), write_unify_write(Us, Rs, Out), tab(Out, 12), write(Out, '((VariableTerm) '), write_reg(X, Out), write(Out, ').bind(new ListTerm('), write_reg_args(Rs, Out), write(Out, '), engine.trail);'), nl(Out), % otherwise fail tab(Out, 8), write(Out, '} else {'), nl(Out), tab(Out, 12), write(Out, 'return engine.fail();'), nl(Out), tab(Out, 8), write(Out, '}'), nl(Out). write_java0(get_str(_F/A,Xi,Xj), In, Out) :- !, write_java0(deref(Xj,Xj), In, Out), read_instructions(A, In, Us), % read mode tab(Out, 8), write(Out, 'if ('), write_reg(Xj, Out), write(Out, ' instanceof StructureTerm){'), nl(Out), %??? == F tab(Out, 12), write(Out, 'if (! '), write_reg(Xi, Out), write(Out, '.equals(((StructureTerm)'), write_reg(Xj, Out), write(Out, ').functor()))'), nl(Out), tab(Out, 16), write(Out, 'return engine.fail();'), nl(Out), tab(Out, 12), write(Out, 'Term[] args = ((StructureTerm)'), write_reg(Xj, Out), write(Out, ').args();'), nl(Out), write_unify_read(Us, 0, Out), % write mode tab(Out, 8), write(Out, '} else if ('), write_reg(Xj, Out), write(Out, ' instanceof VariableTerm){'), nl(Out), write_unify_write(Us, Rs, Out), tab(Out, 12), write(Out, 'Term[] args = {'), write_reg_args(Rs, Out), write(Out, '};'), nl(Out), tab(Out, 12), write(Out, '((VariableTerm) '), write_reg(Xj, Out), write(Out, ').bind(new StructureTerm('), write_reg(Xi, Out), write(Out, ', args), engine.trail);'), nl(Out), % otherwise fail tab(Out, 8), write(Out, '} else {'), nl(Out), tab(Out, 12), write(Out, 'return engine.fail();'), nl(Out), tab(Out, 8), write(Out, '}'), nl(Out). %%% Choice Instructions write_java0(try(Li,Lj), _, Out) :- !, clause(current_arity(A), _), tab(Out, 8), write(Out, 'return engine.jtry'), write(Out, A), write(Out, '('), write_index(Li, Out), write(Out, ', '), write_index(Lj, Out), write(Out, ');'), nl(Out). write_java0(retry(Li,Lj), _, Out) :- !, tab(Out, 8), write(Out, 'return engine.retry('), write_index(Li, Out), write(Out, ', '), write_index(Lj, Out), write(Out, ');'), nl(Out). write_java0(trust(L), _, Out) :- !, tab(Out, 8), write(Out, 'return engine.trust('), write_index(L, Out), write(Out, ');'), nl(Out). %%% Indexing Instructions write_java0(switch_on_term(Lv,Li,Lf,Lc,Ls,Ll), _, Out) :- !, tab(Out, 8), write(Out, 'return engine.switch_on_term('), write_index(Lv, Out), write(Out, ', '), write_index(Li, Out), write(Out, ', '), write_index(Lf, Out), write(Out, ', '), write_index(Lc, Out), write(Out, ', '), write_index(Ls, Out), write(Out, ', '), write_index(Ll, Out), write(Out, ');'), nl(Out). write_java0(switch_on_hash(Tag,_,L, _), _, Out) :- !, tab(Out, 8), write(Out, 'return engine.switch_on_hash('), (Tag == int -> write(Out, 'Int') ; write(Out, Tag)), write(Out, ', '), write_index(L, Out), write(Out, ');'), nl(Out). write_java0(Instruction, _, _) :- am2j_error([Instruction,is,an,invalid,instruction]), fail. /***************************************************************** Write Label *****************************************************************/ write_label(main(F/A, Modifier), Out) :- !, % Import class constants within translation unit clause(current_package(P), _), nl(Out), write(Out, 'import static '), write_package(P, Out), write(Out, '.'), write_class_name(F/A, Out), write(Out, '.*;'), nl(Out), nl(Out), % Class definition (Modifier == (public) -> write(Out, 'public ') ; true), write(Out, 'final class '), write_class_name(F/A, Out), write(Out, ' extends '), write_predicate_base_class(A, Out), write(Out, ' {'), nl(Out). write_label(F/A, Out) :- !, % instance variable declaration (A > 4 -> nl(Out), write_enum('private final Term ', arg, 5, A, ', ', ';', 4, Out), nl(Out) ; true ), % constructor nl(Out), write_constructor(F/A, Out), nl(Out), % exec method nl(Out), tab(Out, 4), write(Out, '@Override'), nl(Out), tab(Out, 4), write(Out, 'public Operation exec(Prolog engine) {'), nl(Out). write_label(L, Out) :- tab(Out, 4), write(Out, '}'), nl(Out), write(Out, '}'), nl(Out), nl(Out), % class for control instructions and clauses write(Out, 'final class '), write_class_name(L, Out), write(Out, ' extends Operation {'), nl(Out), tab(Out, 4), write(Out, '@Override'), nl(Out), tab(Out, 4), write(Out, 'public Operation exec(Prolog engine) {'), nl(Out), !. write_label(Instruction, _, _) :- am2j_error([Instruction,is,an,invalid,instruction]), fail. /***************************************************************** Write Constructor *****************************************************************/ write_constructor(F/A, Out) :- tab(Out, 4), write(Out, 'public '), write_class_name(F/A, Out), write(Out, '('), (A > 0 -> write_enum('', 'Term a', 1, A, ', ', ', ', 0, Out) ; true ), write(Out, 'Operation cont) {'), nl(Out), A > 0, for(I, 1, A), tab(Out, 8), write(Out, 'this.'), write(Out, arg), write(Out, I), write(Out, ' = '), write(Out, a), write(Out, I), write(Out, ';'), nl(Out), fail. write_constructor(_, Out) :- tab(Out, 8), write(Out, 'this.cont = cont;'), nl(Out), tab(Out, 4), write(Out, '}'). write_enum(Head, Sym, SN, EN, Delim, _, Tab, Out) :- SN =< EN, tab(Out, Tab), write(Out, Head), for(I, SN, EN), write(Out, Sym), write(Out, I), (I < EN -> write(Out, Delim) ; true), fail. write_enum(_, _, SN, EN, _, Tail, _, Out) :- SN =< EN, write(Out, Tail). /***************************************************************** Write Unify Instructions *****************************************************************/ %%% Read Mode write_unify_read([], _, _) :- !. write_unify_read([unify_void(I)|Xs], N, Out) :- !, N1 is N+I, write_unify_read(Xs, N1, Out). write_unify_read([X|Xs], N, Out) :- write_unify_r(X, N, Out), N1 is N+1, write_unify_read(Xs, N1, Out). write_unify_r(X, _, _) :- var(X), !, am2j_error([unbound,variable,is,found]), fail. write_unify_r(unify_var(X), N, Out) :- !, tab(Out, 12), write_reg(X, Out), write(Out, ' = '), write_reg(args(N), Out), write(Out, ';'), nl(Out). write_unify_r(unify_val(X), N, Out) :- !, tab(Out, 12), write(Out, 'if (! '), write_reg(X, Out), write(Out, '.unify('), write_reg(args(N), Out), write(Out, ', engine.trail))'), nl(Out), tab(Out, 16), write(Out, 'return engine.fail();'), nl(Out). write_unify_r(unify_int(_,X), N, Out) :- !, %??? write_unify_r(unify_val(X), N, Out). write_unify_r(unify_float(_,X), N, Out) :- !, %??? write_unify_r(unify_val(X), N, Out). write_unify_r(unify_con(_,X), N, Out) :- !, %??? write_unify_r(unify_val(X), N, Out). write_unify_r(unify_ground(_,X), N, Out) :- !, write_unify_r(unify_val(X), N, Out). write_unify_r(X, _, _) :- am2j_error([X,is,an,invalid,instruction]), fail. %%% Write Mode write_unify_write([], [], _) :- !. write_unify_write([unify_void(0)|Xs], Rs, Out) :- !, write_unify_write(Xs, Rs, Out). write_unify_write([unify_void(I)|Xs], [void|Rs], Out) :- I > 0, !, I1 is I-1, write_unify_write([unify_void(I1)|Xs], Rs, Out). write_unify_write([X|Xs], [R|Rs], Out) :- write_unify_w(X, R, Out), write_unify_write(Xs, Rs, Out). write_unify_w(X, _, _) :- var(X), !, am2j_error([unbound,variable,is,found]), fail. write_unify_w(unify_var(X), X, Out) :- !, tab(Out, 12), write_reg(X, Out), write(Out, ' = new VariableTerm(engine);'), nl(Out). write_unify_w(unify_val(X), X, _) :- !. write_unify_w(unify_int(_,X), X, _) :- !. write_unify_w(unify_float(_,X), X, _) :- !. write_unify_w(unify_con(_,X), X, _) :- !. write_unify_w(unify_ground(_,X), X, _) :- !. write_unify_w(X, _, _) :- am2j_error([X,is,an,invalid,instruction]), fail. /***************************************************************** Write Inline *****************************************************************/ write_inline(X, In, Out) :- write_inline_start(X, Out), write_inline0(X, In, Out), write_inline_end(Out). write_inline_start(Goal, Out) :- tab(Out, 8), write(Out, '//START inline expansion of '), write(Out, Goal), nl(Out). write_inline_end(Out) :- tab(Out, 8), write(Out, '//END inline expansion'), nl(Out). % Control constructs write_inline0(fail, _, Out) :- !, tab(Out, 8), write(Out, 'return engine.fail();'), nl(Out). write_inline0('$get_level'(X), _, Out) :- !, write_if_fail(op('!', unify(X,#('new IntegerTerm'('engine.B0')))), [], 8, Out). write_inline0('$neck_cut', _, Out) :- !, tab(Out, 8), write(Out, 'engine.neckCut();'), nl(Out). write_inline0('$cut'(X), _, Out) :- !, write_deref_args([X], Out), tab(Out, 8), write(Out, 'if ('), write_reg(X, Out), write(Out, ' instanceof IntegerTerm) {'), nl(Out), tab(Out, 12), write(Out, 'engine.cut(((IntegerTerm) '), write_reg(X, Out), write(Out, ').intValue());'), nl(Out), tab(Out, 8), write(Out, '} else {'), nl(Out), tab(Out, 12), write(Out, 'throw new IllegalTypeException("integer", '), write_reg(X, Out), write(Out, ');'), nl(Out), tab(Out, 8), write(Out, '}'), nl(Out). % Term unification write_inline0('$unify'(X,Y), _, Out) :- !, write_if_fail(op('!', unify(X,Y)), [], 8, Out). write_inline0('$not_unifiable'(X,Y), _, Out) :- !, write_if_fail(unify(X,Y), [], 8, Out). % Type testing write_inline0(var(X), _, Out) :- !, write_if_fail(op('!', instanceof(X, 'VariableTerm')), [X], 8, Out). write_inline0(atom(X), _, Out) :- !, write_if_fail(op('!', instanceof(X, 'SymbolTerm')), [X], 8, Out). write_inline0(integer(X), _, Out) :- !, write_if_fail(op('!', instanceof(X, 'IntegerTerm')), [X], 8, Out). write_inline0(float(X), _, Out) :- !, write_if_fail(op('!', instanceof(X, 'DoubleTerm')), [X], 8, Out). write_inline0(nonvar(X), _, Out) :- !, write_if_fail(instanceof(X, 'VariableTerm'), [X], 8, Out). write_inline0(number(X), _, Out) :- !, NI = op('!', instanceof(X, 'IntegerTerm')), ND = op('!', instanceof(X, 'DoubleTerm')), write_if_fail(op('&&', NI, ND) , [X], 8, Out). write_inline0(java(X), _, Out) :- !, write_if_fail(op('!', instanceof(X, 'JavaObjectTerm')), [X], 8, Out). write_inline0(closure(X), _, Out) :- !, write_if_fail(op('!', instanceof(X, 'ClosureTerm')), [X], 8, Out). write_inline0(atomic(X), _, Out) :- !, NS = op('!', instanceof(X, 'SymbolTerm')), NI = op('!', instanceof(X, 'IntegerTerm')), ND = op('!', instanceof(X, 'DoubleTerm')), write_if_fail(op('&&', NS, op('&&', NI, ND)) , [X], 8, Out). write_inline0(java(X,Y), _, Out) :- !, write_if_fail(op('!', instanceof(X, 'JavaObjectTerm')), [X], 8, Out), EXP = #('SymbolTerm.create'(@(getName(@(getClass(@(object(cast('JavaObjectTerm',X))))))))), write_if_fail(op('!', unify(Y,EXP)), [], 8, Out). write_inline0(ground(X), _, Out) :- !, write_if_fail(op('!', @('isGround'(X))), [X], 8, Out). % Term comparison write_inline0('$equality_of_term'(X,Y), _, Out) :- !, write_if_fail(op('!',@('equals'(X,Y))), [X,Y], 8, Out). write_inline0('$inequality_of_term'(X,Y), _, Out) :- !, write_if_fail(@('equals'(X,Y)), [X,Y], 8, Out). write_inline0('$after'(X,Y), _, Out) :- !, write_if_fail(op('<=',@('compareTo'(X,Y)),0), [X,Y], 8, Out). write_inline0('$before'(X,Y), _, Out) :- !, write_if_fail(op('>=',@('compareTo'(X,Y)),0), [X,Y], 8, Out). write_inline0('$not_after'(X,Y), _, Out) :- !, write_if_fail(op('>', @('compareTo'(X,Y)),0), [X,Y], 8, Out). write_inline0('$not_before'(X,Y), _, Out) :- !, write_if_fail(op('<', @('compareTo'(X,Y)),0), [X,Y], 8, Out). write_inline0('$identical_or_cannot_unify'(X,Y), _, Out) :- !, write_if_fail(op('&&', op('!',@('equals'(X,Y))), unify(X,Y)), [X,Y], 8, Out). % Term creation and decomposition write_inline0(copy_term(X,Y), _, Out) :- nonvar(X), nonvar(Y), !, write_if_fail(op('!', unify(Y, #('engine.copy'(X)))), [X], 8, Out). % Arithmetic evaluation write_inline0(is(X,Y), _, Out) :- !, write_arith(_, Y, X, 8, Out). write_inline0('$abs'(X,Y), _, Out) :- !, write_arith('abs', X, Y, 8, Out). write_inline0('$asin'(X,Y), _, Out) :- !, write_arith('asin', X, Y, 8, Out). write_inline0('$acos'(X,Y), _, Out) :- !, write_arith('acos', X, Y, 8, Out). write_inline0('$atan'(X,Y), _, Out) :- !, write_arith('atan', X, Y, 8, Out). write_inline0('$bitwise_conj'(X,Y,Z), _, Out) :- !, write_arith('and', X, Y, Z, 8, Out). write_inline0('$bitwise_disj'(X,Y,Z), _, Out) :- !, write_arith('or', X, Y, Z, 8, Out). write_inline0('$bitwise_exclusive_or'(X,Y,Z), _, Out) :- !, write_arith('xor', X, Y, Z, 8, Out). write_inline0('$bitwise_neg'(X,Y), _, Out) :- !, write_arith('not', X, Y, 8, Out). write_inline0('$ceil'(X,Y), _, Out) :- !, write_arith('ceil', X, Y, 8, Out). write_inline0('$cos'(X,Y), _, Out) :- !, write_arith('cos', X, Y, 8, Out). write_inline0('$degrees'(X,Y), _, Out) :- !, write_arith('toDegrees', X, Y, 8, Out). write_inline0('$exp'(X,Y), _, Out) :- !, write_arith('exp', X, Y, 8, Out). write_inline0('$float'(X,Y), _, Out) :- !, write_arith('toFloat', X, Y, 8, Out). write_inline0('$float_integer_part'(X,Y), _, Out) :- !, write_arith('floatIntPart', X, Y, 8, Out). write_inline0('$float_fractional_part'(X,Y), _, Out) :- !, write_arith('floatFractPart', X, Y, 8, Out). write_inline0('$float_quotient'(X,Y,Z), _, Out) :- !, write_arith('divide', X, Y, Z, 8, Out). write_inline0('$floor'(X,Y), _, Out) :- !, write_arith('floor', X, Y, 8, Out). write_inline0('$int_quotient'(X,Y,Z), _, Out) :- !, write_arith('intDivide', X, Y, Z, 8, Out). write_inline0('$log'(X,Y), _, Out) :- !, write_arith('log', X, Y, 8, Out). write_inline0('$max'(X,Y,Z), _, Out) :- !, write_arith('max', X, Y, Z, 8, Out). write_inline0('$min'(X,Y,Z), _, Out) :- !, write_arith('min', X, Y, Z, 8, Out). write_inline0('$minus'(X,Y,Z), _, Out) :- !, write_arith('subtract', X, Y, Z, 8, Out). write_inline0('$mod'(X,Y,Z), _, Out) :- !, write_arith('mod', X, Y, Z, 8, Out). write_inline0('$multi'(X,Y,Z), _, Out) :- !, write_arith('multiply', X, Y, Z, 8, Out). write_inline0('$plus'(X,Y,Z), _, Out) :- !, write_arith('add', X, Y, Z, 8, Out). write_inline0('$pow'(X,Y,Z), _, Out) :- !, write_arith('pow', X, Y, Z, 8, Out). write_inline0('$radians'(X,Y), _, Out) :- !, write_arith('toRadians', X, Y, 8, Out). write_inline0('$rint'(X,Y), _, Out) :- !, write_arith('rint', X, Y, 8, Out). write_inline0('$round'(X,Y), _, Out) :- !, write_arith('round', X, Y, 8, Out). write_inline0('$shift_left'(X,Y,Z), _, Out) :- !, write_arith('shiftLeft', X, Y, Z, 8, Out). write_inline0('$shift_right'(X,Y,Z), _, Out) :- !, write_arith('shiftRight', X, Y, Z, 8, Out). write_inline0('$sign'(X,Y), _, Out) :- !, write_arith('signum', X, Y, 8, Out). write_inline0('$sin'(X,Y), _, Out) :- !, write_arith('sin', X, Y, 8, Out). write_inline0('$sqrt'(X,Y), _, Out) :- !, write_arith('sqrt', X, Y, 8, Out). write_inline0('$tan'(X,Y), _, Out) :- !, write_arith('tan', X, Y, 8, Out). write_inline0('$truncate'(X,Y), _, Out) :- !, write_arith('truncate', X, Y, 8, Out). % Arithmetic comparison write_inline0('$arith_equal'(X,Y), _, Out) :- !, write_arith_compare('!=', X, Y, 8, Out). write_inline0('$arith_not_equal'(X,Y), _, Out) :- !, write_arith_compare('==', X, Y, 8, Out). write_inline0('$greater_or_equal'(X,Y), _, Out) :- !, write_arith_compare('<', X, Y, 8, Out). write_inline0('$greater_than'(X,Y), _, Out) :- !, write_arith_compare('<=', X, Y, 8, Out). write_inline0('$less_or_equal'(X,Y), _, Out) :- !, write_arith_compare('>', X, Y, 8, Out). write_inline0('$less_than'(X,Y), _, Out) :- !, write_arith_compare('>=', X, Y, 8, Out). write_deref_args([], _) :- !. write_deref_args([s(_)|Xs], Out) :- !, write_deref_args(Xs, Out). write_deref_args([si(_)|Xs], Out) :- !, % ??? write_deref_args(Xs, Out). write_deref_args([sf(_)|Xs], Out) :- !, % ??? write_deref_args(Xs, Out). write_deref_args([X|Xs], Out) :- write_java0(deref(X,X), _, Out), write_deref_args(Xs, Out). write_if_fail(Cond, Args, Tab, Out) :- nonvar(Cond), ground(Args), !, EXP = if_then(Cond, 'return engine.fail()'), write_deref_args(Args, Out), write_inline_java(EXP, Tab, Out). make_arith_arg(E, _) :- var(E), !, fail. make_arith_arg(E, E) :- E = si(_), !. make_arith_arg(E, E) :- E = sf(_), !. %make_arith_arg(E, cast('NumberTerm',E)) :- E = a(_), !. %??? make_arith_arg(E, #('Arithmetic.evaluate'(E))). write_arith(M, E, V, Tab, Out) :- make_arith_arg(E, A1), nonvar(V), ( nonvar(M) -> A0 =.. [M,A1], A = @(A0) ; A = A1 ), EXP = try_catch(SENT, 'BuiltinException', ['e.goal = this','throw e']), SENT = if_then(op('!', unify(V,A)), 'return engine.fail()'), %write_deref_args([E], Out), write_inline_java(EXP, Tab, Out). write_arith(M, E1, E2, V, Tab, Out) :- nonvar(M), make_arith_arg(E1, A1), make_arith_arg(E2, A2), nonvar(V), A0 =.. [M,A1,A2], A = @(A0), EXP = try_catch(SENT, 'BuiltinException', ['e.goal = this','throw e']), SENT = if_then(op('!', unify(V,A)), 'return engine.fail()'), %write_deref_args([E1,E2], Out), write_inline_java(EXP, Tab, Out). write_arith_compare(M, E1, E2, Tab, Out) :- nonvar(M), make_arith_arg(E1, A1), make_arith_arg(E2, A2), A0 =.. ['arithCompareTo',A1,A2], A = @(A0), EXP = try_catch(SENT, 'BuiltinException', ['e.goal = this','throw e']), SENT = if_then(op(M, A, 0), 'return engine.fail()'), %write_deref_args([E1,E2], Out), write_inline_java(EXP, Tab, Out). write_inline_java(X, _, _) :- var(X), !, fail. write_inline_java([], _, _) :- !. write_inline_java([X|Xs], Tab, Out) :- !, write_inline_java(X, Tab, Out), write_inline_java(Xs, Tab, Out). write_inline_java(try_catch(TRY,EXCEPT,CATCH), Tab, Out) :- !, tab(Out, Tab), write(Out, 'try {'), nl(Out), Tab1 is Tab + 4, write_inline_java(TRY, Tab1, Out), tab(Out, Tab), write(Out, '} catch ('), write(Out, EXCEPT), write(Out, ' e) {'), nl(Out), write_inline_java(CATCH, Tab1, Out), tab(Out, Tab), write(Out, '}'), nl(Out). write_inline_java(if_then(IF, THEN), Tab, Out) :- !, tab(Out, Tab), write(Out, 'if ('), write_inline_exp(IF, 0, Out), write(Out, ') {'), nl(Out), Tab1 is Tab + 4, write_inline_java(THEN, Tab1, Out), tab(Out, Tab), write(Out, '}'), nl(Out). write_inline_java(if_then_else(IF, THEN, ELSE), Tab, Out) :- !, tab(Out, Tab), write(Out, 'if ('), write_inline_exp(IF, 0, Out), write(Out, ') {'), nl(Out), Tab1 is Tab + 4, write_inline_java(THEN, Tab1, Out), tab(Out, Tab), write(Out, '} else {'), nl(Out), write_inline_java(ELSE, Tab1, Out), tab(Out, Tab), write(Out, '}'), nl(Out). write_inline_java(X, Tab, Out) :- tab(Out, Tab), write(Out, X), write(Out, ';'), nl(Out). write_inline_exp(X, _, _) :- var(X), !, fail. write_inline_exp([], _, _) :- !. write_inline_exp([X], Tab, Out) :- !, write_inline_exp(X, Tab, Out). write_inline_exp([X|Xs], Tab, Out) :- !, write_inline_exp(X, Tab, Out), write(Out, ','), write_inline_exp(Xs, 0, Out). write_inline_exp(bracket(Exp), Tab, Out) :- !, tab(Out, Tab), write(Out, '('), write_inline_exp(Exp, 0, Out), write(Out, ')'). write_inline_exp(op(Op, Exp), Tab, Out) :- !, tab(Out, Tab), write(Out, Op), write(Out, ' '), write_inline_exp(Exp, 0, Out). write_inline_exp(op(Op, Exp1, Exp2), Tab, Out) :- !, tab(Out, Tab), write_inline_exp(Exp1, 0, Out), write(Out, ' '), write(Out, Op), write(Out, ' '), write_inline_exp(Exp2, 0, Out). write_inline_exp(instanceof(Exp,Class), Tab, Out) :- !, tab(Out, Tab), write(Out, '('), write_inline_exp(Exp, 0, Out), write(Out, ' instanceof '), write(Out, Class), write(Out, ')'). write_inline_exp(cast(Class,Exp), Tab, Out) :- !, tab(Out, Tab), write(Out, '(('), write(Out, Class), write(Out, ') '), write_inline_exp(Exp, 0, Out), write(Out, ')'). write_inline_exp(unify(X,Y), Tab, Out) :- !, tab(Out, Tab), write_inline_exp(X, 0, Out), write(Out, '.unify('), write_inline_exp(Y, 0, Out), write(Out, ', engine.trail)'). write_inline_exp(#(X), Tab, Out) :- !, X =.. [F|As], tab(Out, Tab), write(Out, F), write(Out, '('), write_inline_exp(As, 0, Out), write(Out, ')'). write_inline_exp(@(X), Tab, Out) :- !, X =.. [F|As], write_inline_method(F, As, Tab, Out). write_inline_exp(X, Tab, Out) :- X = s(_), !, tab(Out, Tab), write_reg(X, Out). write_inline_exp(X, Tab, Out) :- X = si(_), !, % ??? tab(Out, Tab), write_reg(X, Out). write_inline_exp(X, Tab, Out) :- X = sf(_), !, % ??? tab(Out, Tab), write_reg(X, Out). write_inline_exp(X, Tab, Out) :- X = a(_), !, tab(Out, Tab), write_reg(X, Out). write_inline_exp(X, Tab, Out) :- X == void, !, % ??? tab(Out, Tab), write_reg(X, Out). write_inline_exp(X, Tab, Out) :- tab(Out, Tab), write(Out, X). write_inline_method(F, _, _, _) :- var(F), !, fail. write_inline_method(_, A, _, _) :- var(A), !, fail. write_inline_method(F, [A], Tab, Out) :- !, tab(Out, Tab), write_inline_exp(A, 0, Out), write(Out, '.'), write(Out, F), write(Out, '()'). write_inline_method(F, [A,B], Tab, Out) :- tab(Out, Tab), write_inline_exp(A, 0, Out), write(Out, '.'), write(Out, F), write(Out, '('), write_inline_exp(B, 0, Out), write(Out, ')'). /***************************************************************** Write Insert *****************************************************************/ write_insert(X, _, _) :- var(X), !, fail. write_insert([], _, _) :- !. write_insert([X|Xs], _, Out) :- atom(X), write(Out, X), nl(Out), write_insert(Xs, _, Out). /***************************************************************** Auxiliaries *****************************************************************/ % Create a directory if missing mkdirs(Dir) :- exists_directory(Dir), !. mkdirs(Dir) :- file_directory_name(Dir, Parent), mkdirs(Parent), make_directory(Dir). % int java_integer(X) :- integer(X), -2147483648 =< X, X =< 2147483647. % Read Instructions read_instructions(0, _, []) :- !. read_instructions(N, In, [X|Xs]) :- N > 0, read(In, X), N1 is N-1, read_instructions(N1, In, Xs). % Write package name write_package(P, Out) :- !, write(Out, P). % Write class name write_class_name(L, Out) :- write(Out, 'PRED_'), write_index(L, Out). % Write out base class name write_predicate_base_class(0, Out) :- !, write(Out, 'Predicate'). write_predicate_base_class(1, Out) :- !, write(Out, 'Predicate.P1'). write_predicate_base_class(2, Out) :- !, write(Out, 'Predicate.P2'). write_predicate_base_class(3, Out) :- !, write(Out, 'Predicate.P3'). write_predicate_base_class(4, Out) :- !, write(Out, 'Predicate.P4'). write_predicate_base_class(_, Out) :- !, write(Out, 'Predicate.P4'). % Write label write_index(F/A, Out) :- !, write_pred_spec(F/A, Out). write_index(L+I, Out) :- write_index(L, Out), write(Out, '_'), write(Out, I). % Write constant name write_constant(X, Out) :- constant_encoding(X, Y), write(Out, Y). % Write predicate specification write_pred_spec(F/A, Out) :- predicate_encoding(F, F1), write(Out, F1), write(Out, '_'), write(Out, A). % Package name as directory package_encoding(P, Dir) :- atom_codes(P, Chs0), package_encoding(Chs0, Chs, []), atom_codes(Dir, Chs). package_encoding([]) --> !. package_encoding([46|Xs]) --> !, [47], package_encoding(Xs). package_encoding([X|Xs]) --> !, [X] , package_encoding(Xs). % Predicate Encoding predicate_encoding(X, Y) :- atom_codes(X, Chs0), pred_encoding(Chs0, Chs, []), atom_codes(Y, Chs). pred_encoding([]) --> !. pred_encoding([X|Xs]) --> pred_encoding_char(X), pred_encoding(Xs). pred_encoding_char(X) --> {97 =< X, X =< 122}, !, [X]. % a..z pred_encoding_char(X) --> {65 =< X, X =< 90}, !, [X]. % A..Z pred_encoding_char(X) --> {48 =< X, X =< 57}, !, [X]. % 0..9 pred_encoding_char(95) --> !, [95]. % '_' pred_encoding_char(36) --> !, [36]. % '$' ??? pred_encoding_char(X) --> {0 =< X, X =< 65535}, !, [36], % '$' pred_encoding_hex(X). pred_encoding_char(X) --> {am2j_error([X,is,an,invalid,character,code]), fail}. pred_encoding_hex(X) --> {int_to_hex(X, [], H)}, pred_encoding_hex_char(H). pred_encoding_hex_char([]) --> !, [48,48,48,48]. % 0000 pred_encoding_hex_char([X]) --> !, [48,48,48, X]. % 000X pred_encoding_hex_char([X,Y]) --> !, [48,48, X, Y]. % 00XY pred_encoding_hex_char([X,Y,Z]) --> !, [48, X, Y, Z]. % 0XYZ pred_encoding_hex_char([X,Y,Z,W]) --> !, [ X, Y, Z, W]. % XYZW int_to_hex(0, H, H) :- !. int_to_hex(D, H0, H) :- R is D mod 16, D1 is D//16, hex_map(R, R1), int_to_hex(D1, [R1|H0], H). hex_map(10, 65) :- !. % 'A' hex_map(11, 66) :- !. % 'B' hex_map(12, 67) :- !. % 'C' hex_map(13, 68) :- !. % 'D' hex_map(14, 69) :- !. % 'E' hex_map(15, 70) :- !. % 'F' hex_map(X, Y) :- 0 =< X, X =< 9, number_codes(X, [Y]). % Constant Encoding (especially, escape sequence) constant_encoding(X, Y) :- atom_codes(X, Chs0), con_encoding(Chs0, Chs), %??? atom_codes(Y, Chs). con_encoding([], []) :- !. con_encoding([ 7|Xs], [92, 97|Ys]):- !, con_encoding(Xs, Ys). % \a con_encoding([ 8|Xs], [92, 98|Ys]):- !, con_encoding(Xs, Ys). % \b con_encoding([ 9|Xs], [92,116|Ys]):- !, con_encoding(Xs, Ys). % \t con_encoding([10|Xs], [92,110|Ys]):- !, con_encoding(Xs, Ys). % \n con_encoding([11|Xs], [92,118|Ys]):- !, con_encoding(Xs, Ys). % \v con_encoding([12|Xs], [92,102|Ys]):- !, con_encoding(Xs, Ys). % \f con_encoding([13|Xs], [92,114|Ys]):- !, con_encoding(Xs, Ys). % \r con_encoding([34|Xs], [92, 34|Ys]):- !, con_encoding(Xs, Ys). % \" - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -