blob: 04a39b45d5649aa1a6a22f4c20b0492afcb5a4bf [file] [log] [blame]
/*****************************************************************
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_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(fail/0), _, Out) :- !,
tab(Out, 4),
write(Out, 'static final Operation '),
write_index(fail/0, Out),
write(Out, ' = com.googlecode.prolog_cafe.lang.Failure.FAIL_0'),
write(Out, ';'), nl(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<Term, Operation> '),
(Tag == int -> write(Out, 'Int') ; write(Out, Tag)),
write(Out, ' = new java.util.HashMap<Term, Operation>('),
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, '.isInteger()){'), 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, '.isVariable()){'), 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, '.isDouble()){'), 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, '.isVariable()){'), 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, '.isSymbol()){'), 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, '.isVariable()){'), 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, '.isList()){'), 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, '.isVariable()){'), 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, '.isStructure()){'), 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, '.isVariable()){'), 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_index(Li, Out),
write(Out, ', '),
write_index(Lj, Out),
write(Out, ', '),
( A == 0 ->
write(Out, 'new S0()')
;
write(Out, 'new S'), write(Out, A), write(Out, '(engine)')
),
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, '.isInteger()) {'), nl(Out),
tab(Out, 12),
write(Out, 'throw new IllegalTypeException("integer", '),
write_reg(X, Out), write(Out, ');'), nl(Out),
tab(Out, 8),
write(Out, '} else {'), nl(Out),
tab(Out, 12),
write(Out, 'engine.cut(((IntegerTerm) '), write_reg(X, Out),
write(Out, ').intValue());'), 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('!', @('isVariable'(X))), [X], 8, Out).
write_inline0(atom(X), _, Out) :- !, write_if_fail(op('!', @('isSymbol'(X))), [X], 8, Out).
write_inline0(integer(X), _, Out) :- !, write_if_fail(op('!', @('isInteger'(X))), [X], 8, Out).
write_inline0(float(X), _, Out) :- !, write_if_fail(op('!', @('isDouble'(X))), [X], 8, Out).
write_inline0(nonvar(X), _, Out) :- !, write_if_fail(@('isVariable'(X)), [X], 8, Out).
write_inline0(number(X), _, Out) :- !, write_if_fail(op('!', @('isNumber'(X))), [X], 8, Out).
write_inline0(java(X), _, Out) :- !, write_if_fail(op('!', @('isJavaObject'(X))), [X], 8, Out).
write_inline0(closure(X), _, Out) :- !, write_if_fail(op('!', @('isClosure'(X))), [X], 8, Out).
write_inline0(atomic(X), _, Out) :- !,
write_if_fail(op('&&',op('!',@('isSymbol'(X))), op('!',@('isNumber'(X)))), [X], 8, Out).
write_inline0(java(X,Y), _, Out) :- !,
write_if_fail(op('!', @('isJavaObject'(X))), [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(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). % \"
con_encoding([39|Xs], [92, 39|Ys]):- !, con_encoding(Xs, Ys). % \'
con_encoding([92|Xs], [92, 92|Ys]):- !, con_encoding(Xs, Ys). % \\
con_encoding([X|Xs], [X|Ys]):- con_encoding(Xs, Ys).
% Write Register name
write_reg(X, _) :- var(X), !,
am2j_error([register,expression,must,not,be,unbound,variable]),
fail.
write_reg(void, Out) :- !, write(Out, 'new VariableTerm(engine)').
write_reg(ea(R), Out) :- 1 =< R, R =< 10, !, write(Out, 'engine.r'), write(Out, R).
write_reg(econt, Out) :- !, write(Out, 'engine.cont').
write_reg(arg(X), Out) :- !, write(Out, arg), write(Out, X).
write_reg(a(X), Out) :- !, write(Out, a), write(Out, X).
write_reg(s(X), Out) :- !, write(Out, s), write(Out, X).
write_reg(si(X), Out) :- !, write(Out, si), write(Out, X). % ???
write_reg(sf(X), Out) :- !, write(Out, sf), write(Out, X). % ???
write_reg(y(X), Out) :- !, write(Out, y), write(Out, X).
write_reg(p(X), Out) :- !, write(Out, p), write(Out, X).
write_reg(cont, Out) :- !, write(Out, cont).
write_reg(null, Out) :- !, write(Out, null).
% am2j only
write_reg(args(X),Out) :- !, write(Out, 'args['), write(Out, X), write(Out, ']').
write_reg(X, _) :-
am2j_error([invalid_register,X]),
fail.
write_reg_args([], _) :- !.
write_reg_args([X], Out) :- !,
write_reg(X, Out).
write_reg_args([X|Xs], Out) :-
write_reg(X, Out),
write(Out, ', '),
write_reg_args(Xs, Out).
/*****************************************************************
WAM-BASED INTERMEDIATE INSTRUCTIONS
Put Instructions
================
+ put_var(X)
+ put_int(i, X)
+ put_float(f, X)
+ put_con(f/n, X)
+ put_con(c, X),
+ put_list(Xi, Xj, Xk)
+ put_str(Xi, Y, Xj)
+ put_str_args([Xi,..,Xn], Y)
+ put_clo(p:G, X)
Get Instructions
================
+ get_val(Xi, Xj)
+ get_int(i, Xi, Xj)
+ get_float(f, Xi, Xj)
+ get_con(c, Xi, Xj)
+ get_ground(g, Xi, Xj)
+ get_list(X)
+ get_str(f/n, Xi, Xj)
Unify Instructions
==================
+ unify_var(X)
+ unify_val(X)
+ unify_int(i, X)
+ unify_float(f, X)
+ unify_con(c, X)
+ unify_ground(g, X)
+ unify_void(i)
Choice Instructions
===================
+ try(Li, Lj)
+ retry(Li, Lj)
+ trust(L)
Indexing Instructions
=====================
+ switch_on_term(Lv, Li, Lf, Lc, Ls, Ll)
+ switch_on_hash(TAG, i, L, hashtable)
Other Instructions
==================
+ comment(Message)
+ debug(Message)
+ begin_predicate(p, f/n)
+ end_predicate(p, f/n)
+ import_package(p)
+ import_package(p, f/n)
+ main(f/n, public): [Instructions]
+ main(f/n, non-public): [Instructions]
+ L: [Instructions]
+ label(L)
+ setB0
+ goto(L)
+ deref(Ri, Rj)
+ set(Ri, Rj)
+ decl_term_vars([R1,...,Rn])
+ decl_pred_vars([R1,...,Rn])
+ put_cont(p:BinG, C)
+ put_cont(BinG, C)
+ execute(p:BinG)
+ execute(BinG)
+ inline(G)
+ new_hash(TAG, i)
+ put_hash(X, L, TAG)
+ static([Instructions])
Notation
********
X ::= a(i) | S
Y ::= y(i) | S
S ::= s(i) | si(i) | sf(i)
L ::= f/n | f/n+i | f/n+TAG | f/n+TAG+i | f/n+TAG+i+i
TAG ::= var | int | flo | con | str | lis | top | sub | nil
BinG ::= C | f(A1,..,An, C)
G ::= f(A1,..,An)
A ::= void | X
C ::= cont | p(N)
R ::= cont | econt | a(i) | arg(i) | ea(i)
*****************************************************************/
/*****************************************************************
Utilities
*****************************************************************/
for(M, M, N) :- M =< N.
for(I, M, N) :- M =< N, M1 is M + 1, for(I, M1, N).
am2j_error(M) :- raise_exception(am2j_error(M)).
%%% list
am2j_append([], Zs, Zs).
am2j_append([X|Xs], Ys, [X|Zs]) :- am2j_append(Xs, Ys, Zs).
flatten_list([]) --> !.
flatten_list([L1|L2]) --> !, flatten_list(L1), flatten_list(L2).
flatten_list(L) --> [L].
list_to_string(List, String) :-
list_to_chars(List, Chars0),
flatten_list(Chars0, Chars, []),
atom_codes(String, Chars).
list_to_chars([], []) :- !.
list_to_chars([L|Ls], [C|Cs]) :- atom(L), !,
atom_codes(L, C),
list_to_chars(Ls, Cs).
list_to_chars([L|Ls], [C|Cs]) :- number(L), !,
number_codes(L, C),
list_to_chars(Ls, Cs).
% END
% written by SICStus Prolog 3.12.8