/*****************************************************************
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