/** * Modern Albufeira Prolog Interpreter * * Warranty & Liability * To the extent permitted by applicable law and unless explicitly * otherwise agreed upon, XLOG Technologies AG makes no warranties * regarding the provided information. XLOG Technologies AG assumes * no liability that any problems might be solved with the information * provided by XLOG Technologies AG. * * Rights & License * All industrial property rights regarding the information - copyright * and patent rights in particular - are the sole property of XLOG * Technologies AG. If the company was not the originator of some * excerpts, XLOG Technologies AG has at least obtained the right to * reproduce, change and translate the information. * * Reproduction is restricted to the whole unaltered document. Reproduction * of the information is only allowed for non-commercial uses. Selling, * giving away or letting of the execution of the library is prohibited. * The library can be distributed as part of your applications and libraries * for execution provided this comment remains unchanged. * * Restrictions * Only to be distributed with programs that add significant and primary * functionality to the library. Not to be distributed with additional * software intended to replace any components of the library. * * Trademarks * Jekejeke is a registered trademark of XLOG Technologies AG. */ /** * Mimicry of sys_clause_ossify/5 and sys_goal_ossify/3. * * - Detect anonymous variables via numberanon/1 * - Detect non-anonymous variables via numbervars/3 * - Detect frozen compounds via transpiled * - Unpack monomorphic caches via native * - Unpack anoynmous predicates via native */ :- ensure_loaded(library(hiord)). :- op(200, fy, 'new Object[]'). % make_print_static(+Term, +Stream) make_print_static(T, OutStream) :- nonvar(T), T = (:- _), !, sys_trans_horn(T, Help, 1), sys_encode_horn(Help, Encode, 1), make_print(Encode, Printable), write(OutStream, ' '), write(OutStream, 'run'(Printable)), write(OutStream, ';\n'). make_print_static(T, OutStream) :- (nonvar(T), T = (H :- _); T = H), !, functor(H, F, N), cross_pred_type(F, N, O), sys_trans_horn(T, Help, O), sys_encode_horn(Help, Encode, O), make_print(Encode, Printable), write(OutStream, ' '), write(OutStream, 'add'(Printable)), write(OutStream, ';\n'), cross_touch_static(F, N). /*******************************************************************/ /* Make Printable */ /*******************************************************************/ % make_print(+IRClauseOrGoal, -JObject) make_print(T, _) :- var(T), throw(error(instantiation_error,_)). make_print(tr_clause(M,R,L), 'new Clause'(N,G,'new Object[]'(S), 'new Object[]'(T),K)) :- U = tr_clause(M,R,L), !, numberanon(U), numbervars(U, 0, N), R =.. [F|H], make_print_const(F, G), make_print_instrs(H, X), make_print_instrs(L, Y), make_print_list(X, S), make_print_list(Y, T), make_print_cutvar(M, K). make_print(tr_goal(M,R), 'new Goal'(N,'new Object[]'(S),K)) :- U = tr_goal(M,R), !, numberanon(U), numbervars(U, 0, N), make_print_instrs(R, X), make_print_list(X, S), make_print_cutvar(M, K). make_print(T, _) :- throw(error(type_error(ir_clause_or_goal, T),_)). % make_print_cutvar(+IROption, -JObject) make_print_cutvar(T, _) :- var(T), throw(error(instantiation_error,_)). make_print_cutvar(nothing, -1) :- !. make_print_cutvar(just('$VAR'(K)), K) :- integer(K), !. make_print_cutvar(T, _) :- throw(error(type_error(ir_option, T),_)). /*******************************************************************/ /* Make Compound */ /*******************************************************************/ % make_print_instr(+IRInstr, -JInstr) make_print_instr(V, _) :- var(V), throw(error(instantiation_error,_)). make_print_instr('$ANON', 'UNDEF_OBJ') :- !. make_print_instr('$VAR'(K), 'new Place'(K)) :- integer(K), !. make_print_instr(C, R) :- compound(C), !, C =.. [F|L], make_print_const(F, G), make_print_instrs(L, X), make_print_frozen(G, X, R). make_print_instr(F, G) :- make_print_const(F, G). % make_print_instrs(+IRList, -JList) make_print_instrs(V, _) :- var(V), throw(error(instantiation_error,_)). make_print_instrs([], []) :- !. make_print_instrs([X|L], [Y|R]) :- !, make_print_instr(X, Y), make_print_instrs(L, R). make_print_instrs(T, _) :- throw(error(type_error(ir_list, T),_)). % make_print_frozen(-JAtom, -JList, -JInstr) make_print_frozen(G, X, 'new Skeleton'(G, 'new Object[]'(S))) :- member(A, X), cross_fever(A), !, make_print_list(X, S). make_print_frozen(G, X, 'new Frozen'(G, 'new Object[]'(S))) :- make_print_list(X, S). /*******************************************************************/ /* Make Const */ /*******************************************************************/ % make_print_const(+Atomic, -JAtomic) make_print_const(X, 'new Cache'(G)) :- ir_is_site(X), !, ir_site_name(X, F), make_print_atom(F, G). make_print_const(X, 'make_defined'('new Object[]'(R))) :- ir_is_link(X), !, findall(C, kb_clause_ref(X, 0, C), L), make_print_disj(L, H), make_print_list(H, R). make_print_const(A, B) :- make_print_atomic(A, B). % make_print_disj(+List, -JList) make_print_disj([], []). make_print_disj([C|P], [Y|Q]) :- kb_clause_data(C, R, M, L), make_print(tr_clause(M,R,L), Y), make_print_disj(P, Q). % cross_fever(+JInstr) cross_fever('UNDEF_OBJ'). cross_fever('new Place'(_)). cross_fever('new Skeleton'(_,_)). /** * Create Java source text for * * - Lists * - References * - Numbers * - Atoms */ % make_print_atomic(+Atomic, -JAtomic) make_print_atomic(A, B) :- atom(A), !, make_print_atom(A, B). make_print_atomic(A, B) :- number(A), !, make_print_number(A, B). make_print_atomic(A, B) :- make_print_reference(A, B). /*******************************************************************/ /* List Utility */ /*******************************************************************/ % make_print_list(+List, -Set) make_print_list([], {}). make_print_list([X|Y], {Z}) :- make_print_comma(Y, X, Z). % make_print_comma(+List, +Term -Comma) make_print_comma([], X, X). make_print_comma([X|Y], Z, (Z,T)) :- make_print_comma(Y, X, T). /*******************************************************************/ /* Reference Utility */ /*******************************************************************/ % make_print_reference(+Reference, -JReference) make_print_reference(0rNone, null) :- !. make_print_reference(0rFalse, false) :- !. make_print_reference(0rTrue, true) :- !. make_print_reference(A, _) :- throw(error(domain_error(printable,A),_)). /*******************************************************************/ /* Number Utility */ /*******************************************************************/ % make_print_number(+Number, -Term) make_print_number(0rInf, 'Double.POSITIVE_INFINITY') :- !. make_print_number(-0rInf, 'Double.NEGATIVE_INFINITY') :- !. make_print_number(0rNaN, 'Double.NaN') :- !. make_print_number(A, B) :- integer(A), !, cross_esc_integer(A, B). make_print_number(A, A) :- float(A), !. make_print_number(A, _) :- throw(error(domain_error(printable,A),_)). % cross_esc_integer(+Integer, -JInteger) cross_esc_integer(A, A) :- -2147483648 =< A, A =< 2147483647, !. cross_esc_integer(A, 'new BigInteger'(B)) :- atom_integer(H, 10, A), atom_join(['"', H, '"'], B). /*******************************************************************/ /* Atom Utility */ /*******************************************************************/ % make_print_atom(+Atom, -Atom) make_print_atom(X, Y) :- atom_codes(X, L), cross_esc_codes(L, R, [0'"]), atom_codes(Y, [0'"|R]). % cross_esc_codes(+List, -List, +List) cross_esc_codes([X|L]) --> cross_esc_code(X), cross_esc_codes(L). cross_esc_codes([]) --> []. % cross_esc_code(+Integer, -List, +List) cross_esc_code(X) --> {cross_is_escape(Y, X)}, !, [0'\\, Y]. cross_esc_code(X) --> {cross_is_meta(X)}, !, [0'\\, X]. cross_esc_code(X) --> {cross_is_cntrl(X)}, !, cross_esc_code2(X). cross_esc_code(X) --> {cross_is_invalid(X)}, !, cross_esc_code2(X). cross_esc_code(X) --> [X]. % cross_esc_code2(+Integer, -List, +List) cross_esc_code2(X) --> {X =< 0xFFFF}, !, {atom_integer(J, 16, X), atom_codes(J, H), length(H, N), M is 4-N}, [0'\\, 0'u], cross_esc_zeros(M), cross_esc_codes2(H). cross_esc_code2(X) --> {cross_high_surrogate(X, Y), cross_low_surrogate(X, Z)}, cross_esc_code2(Y), cross_esc_code2(Z). % cross_is_escape(+Code, -Code) cross_is_escape(0'n, 0'\n). cross_is_escape(0't, 0'\t). cross_is_escape(0'b, 0'\b). cross_is_escape(0'f, 0'\f). cross_is_escape(0'r, 0'\r). % cross_is_meta(+Code) cross_is_meta(0'\'). cross_is_meta(0'\"). cross_is_meta(0'\\).