Prolog "transpiler"

         
/**
* 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)).
% 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, '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, '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), 'Clause'(N,G,X,Y,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_cutvar(M, K).
make_print(tr_goal(M,R), 'Goal'(N,X,K)) :- U = tr_goal(M,R), !,
numberanon(U),
numbervars(U, 0, N),
make_print_instrs(R, X),
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', 'NotImplemented') :- !.
make_print_instr('$VAR'(K), '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, 'Skeleton'(G, X)) :-
member(A, X), cross_fever(A), !.
make_print_frozen(G, X, 'Frozen'(G, X)).
/*******************************************************************/
/* Make Const */
/*******************************************************************/
% make_print_const(+Atomic, -JAtomic)
make_print_const(X, 'Cache'(G)) :- ir_is_site(X), !,
ir_site_name(X, F),
make_print_atom(F, G).
make_print_const(X, 'make_defined'(R)) :- ir_is_link(X), !,
findall(C, kb_clause_ref(X, 0, C), L),
make_print_disj(L, 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('NotImplemented').
cross_fever('Place'(_)).
cross_fever('Skeleton'(_,_)).
/**
* Create Python source text for
*
* - References
* - Numbers
* - Atoms
*/
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).
/*************************************************************/
/* Reference Utility */
/*************************************************************/
% make_print_reference(+Reference, -PyReference)
make_print_reference(0rNone, 'None') :- !.
make_print_reference(0rFalse, 'False') :- !.
make_print_reference(0rTrue, 'True') :- !.
make_print_reference(A, _) :-
throw(error(domain_error(printable,A),_)).
/*************************************************************/
/* Number Utility */
/*************************************************************/
% make_print_reference(+Number, -PyNumber)
make_print_number(0rInf, 'math.inf') :- !.
make_print_number(-0rInf, '-math.inf') :- !.
make_print_number(0rNaN, 'math.nan') :- !.
make_print_number(A, A) :- integer(A), !.
make_print_number(A, A) :- float(A), !.
make_print_number(A, _) :-
throw(error(domain_error(printable,A),_)).
/*************************************************************/
/* Atom Utility */
/*************************************************************/
% make_print_atom(+Atom, -PyAtom)
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 =< 0xFF}, !,
{atom_integer(J, 16, X), atom_codes(J, H), length(H, N), M is 2-N},
[0'\\, 0'x], cross_esc_zeros(M), cross_esc_codes2(H).
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) -->
{atom_integer(J, 16, X), atom_codes(J, H), length(H, N), M is 8-N},
[0'\\, 0'U], cross_esc_zeros(M), cross_esc_codes2(H).
% 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_escape(0'a, 0'\a).
cross_is_escape(0'v, 0'\v).
% cross_is_meta(+Code)
cross_is_meta(0'\').
cross_is_meta(0'\").
cross_is_meta(0'\\).

Use Privacy (c) 2005-2026 XLOG Technologies AG