Heimseite
Seitenübersicht
An/abmeldung
Anschlagbrett
Herunterladen(c) 2005-2024 XLOG Technologies AG
/**
* 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.
*/
:- op(200, fy, 'new Object[]').
/*******************************************************************/
/* Transpile Begin */
/*******************************************************************/
/**
* transpilej_begin(B):
* transpilej_begin(B, O):
* The predicate succeeds in writing an empty Java file B.
*/
% transpilej_begin(+Atom)
transpilej_begin(OutName) :-
transpilej_begin(OutName, []).
% transpilej_begin(+Atom, +List)
transpilej_begin(OutName, Opts) :-
decode_transpilej_opts(Opts, v(0,''), v(Flags,Doge)),
copy_text('playerj/cross/header.txt', OutName),
setup_once_cleanup(
open(OutName, append, OutStream),
transpilej_init(OutStream, Flags, Doge),
close(OutStream)).
% transpilej_init(+Stream, +Integer, +Atom)
transpilej_init(OutStream, Flags, Doge) :-
(Flags /\ 2 =\= 0 ->
cross_clear;
true),
(Flags /\ 1 =\= 0 ->
write(OutStream, 'import {add, Clause, Goal, run, make_defined, Compound} from "'),
write(OutStream, Doge),
write(OutStream, '";\n'),
write(OutStream, 'export function main() {\n')
; write(OutStream, 'public final class '),
write(OutStream, Doge),
write(OutStream, ' {\n')).
/*******************************************************************/
/* Transpile Add */
/*******************************************************************/
/**
* transpilej_add(A, B):
* transpilej_add(A, B, O):
* The predicate succeeds in cross compiling the Prolog text file A
* into the Java file B.
*/
% transpilej_add(+Atom, +Atom)
transpilej_add(InName, OutName) :-
transpilej_add(InName, OutName, []).
% transpilej_add(+Atom, +Atom, +List)
transpilej_add(InName, OutName, Opts) :-
decode_transpilej_opts(Opts, v(0,''), v(Flags,Doge)),
setup_once_cleanup(
open(OutName, append, OutStream),
transpilej_loading(InName, OutStream, Flags, Doge),
close(OutStream)).
% transpilej_loading(+Atom, +Stream, +Integer, +Atom)
transpilej_loading(InName, OutStream, Flags, Doge) :-
write(OutStream, ' public static void '),
write(OutStream, Doge),
write(OutStream, '() {\n'),
setup_once_cleanup(
cross_loading_begin(InName),
transpilej_file(InName, OutStream, Flags),
cross_loading_end),
write(OutStream, ' }\n'),
write(OutStream, '\n').
% transpilej_file(+Atom, +Stream, +Integer)
transpilej_file(InName, OutStream, Flags) :-
setup_once_cleanup(
open(InName, read, InStream),
transpilej_stream(InName, InStream, OutStream, Flags),
close(InStream)).
% transpilej_stream(+Atom, +Stream, +Stream, +Integer)
transpilej_stream(InName, InStream, OutStream, Flags) :-
setup_once_cleanup(
asserta(cross_including(InName, InStream)),
transpilej_lines(InStream, OutStream, Flags),
once(retract(cross_including(InName, InStream)))).
% transpilej_lines(+Stream, +Stream, +Integer)
transpilej_lines(InStream, OutStream, Flags) :-
repeat,
read_term(InStream, Term, [singletons(Names)]),
(Term = end_of_file -> !;
skipped_directive(Term) ->
skipped_warning,
fail;
cross_singleton_check(Names),
expand_term(Term, Term2),
cross_style_static(Term2, Flags, List2, List),
cross_replace_term(Term2, Flags, List, []),
member(Term3, List2),
sys_trans_horn(Term3, Help),
transpilej_horn(Help, OutStream, Flags),
fail).
% transpilej_horn(+Clause_or_goal, +Stream, +Integer)
transpilej_horn(V, _, _) :- var(V),
throw(error(instantiation_error,_)).
transpilej_horn(Help, OutStream, Flags) :- Help = tr_clause(_,Head,_), !,
functor(Head, F, N),
cross_pred_type(F, N, O),
sys_encode_horn(Help, Encode, O),
makej_print(Encode, Printable), makej_print_atom(F, G),
(Flags /\ 1 =\= 0 ->
true;
write(OutStream, ' ')),
write(OutStream, 'add'(G, N, Printable)),
write(OutStream, ';\n'),
cross_touch_pred(F, N, 1).
transpilej_horn(Help, OutStream, Flags) :- Help = tr_goal(_), !,
sys_encode_horn(Help, Encode, 1),
makej_print(Encode, Printable),
(Flags /\ 1 =\= 0 ->
true;
write(OutStream, ' ')),
write(OutStream, 'run'(Printable)),
write(OutStream, ';\n').
transpilej_horn(T, _, _) :-
throw(error(type_error(tr_clause_or_goal, T),_)).
/*******************************************************************/
/* Transpile End */
/*******************************************************************/
/**
* transpilej_end(B):
* transpilej_end(B, O):
* The predicate succeeds adding an epilogue to the Java file B.
*/
% transpilej_end(+Atom)
transpilej_end(OutName) :-
transpilej_end(OutName, []).
% transpilej_end(+Atom, +List)
transpilej_end(OutName, Opts) :-
decode_transpilej_opts(Opts, v(0,''), v(Flags,Doge)),
setup_once_cleanup(
open(OutName, append, OutStream),
transpilej_fini(OutStream, Flags, Doge),
close(OutStream)).
% transpilej_fini(+Stream, +Integer, +Atom)
transpilej_fini(OutStream, Flags, Doge) :-
(Flags /\ 2 =\= 0 ->
write(OutStream, ' public static void '),
write(OutStream, Doge),
write(OutStream, '() {\n'),
cross_defered(Term3, Flags),
sys_trans_horn(Term3, Help),
transpilej_horn(Help, OutStream, Flags);
true),
fail.
transpilej_fini(OutStream, Flags, _) :-
(Flags /\ 2 =\= 0 ->
write(OutStream, ' }\n');
true),
(Flags /\ 1 =\= 0 ->
true;
write(OutStream, '}\n')).
/*******************************************************************/
/* Make Printable */
/*******************************************************************/
% makej_print(+IRClauseOrGoal, -JObject)
makej_print(T, _) :- var(T),
throw(error(instantiation_error,_)).
makej_print(ir_clause(A,B,W,C), 'new Clause'(I,'new Object[]'(S),
'new Object[]'(T),W,Z)) :- !,
K is W+1,
makej_print_list(A, X, v(K,[]), v(J,R)),
makej_print_list(B, Y, v(J,R), v(I,_)),
makej_print_option(C, Z),
makej_print_set(X, S),
makej_print_set(Y, T).
makej_print(ir_goal(A), 'new Goal'(I,'new Object[]'(S))) :- !,
makej_print_list(A, X, v(0,[]), v(I,_)),
makej_print_set(X, S).
makej_print(T, _) :-
throw(error(type_error(ir_clause_or_goal, T),_)).
% makej_print_option(+IROption, -JObject)
makej_print_option(T, _) :- var(T),
throw(error(instantiation_error,_)).
makej_print_option(nothing, 'UNDEF_OBJ') :- !.
makej_print_option(just(F), G) :- !,
makej_print_const(F, G).
makej_print_option(T, _) :-
throw(error(type_error(ir_option, T),_)).
% makej_print_list(+IRList, -JList, -List, +List)
makej_print_list(V, _) --> {var(V),
throw(error(instantiation_error,_))}.
makej_print_list([X|L], [Y|R]) --> !,
makej_print_instr(X, Y),
makej_print_list(L, R).
makej_print_list([], []) --> !.
makej_print_list(T, _) -->
{throw(error(type_error(ir_list, T),_))}.
% makej_print_instr(+IRInstr, -JInstr, -List, +List)
makej_print_instr(V, _) --> {var(V),
throw(error(instantiation_error,_))}.
makej_print_instr(first_var(_,G), 'new Place'(-1)) --> {var(G)}, !.
makej_print_instr(first_var(W,_), 'new Place'(V)) --> !,
(makej_print_current_recycle([W|R]) ->
makej_print_set_recycle(R);
makej_print_current_max(W),
{H is W+1},
makej_print_set_max(H)),
{V is (-W)-2}.
makej_print_instr(var(W,G), 'new Place'(W)) --> !,
({var(G)} ->
makej_print_current_recycle(R),
makej_print_set_recycle([W|R]);
[]).
makej_print_instr(functor(F,L), 'new Skeleton'(G, 'new Object[]'(S))) --> !,
{makej_print_const(F, G)},
makej_print_list(L, X),
{makej_print_set(X, S)}.
makej_print_instr(const(F), G) --> !,
{makej_print_const(F, G)}.
makej_print_instr(T, _) -->
{throw(error(type_error(ir_instr, T),_))}.
% makej_print_current_max(-Integer, -List, +List)
makej_print_current_max(I, v(I,R), v(I,R)).
% makej_print_set_max(+Integer, -List, +List)
makej_print_set_max(I, v(_,R), v(I,R)).
% makej_print_current_recycle(-List, -List, +List)
makej_print_current_recycle(R, v(I,R), v(I,R)).
% makej_print_set_recycle(+List, -List, +List)
makej_print_set_recycle(R, v(I,_), v(I,R)).
% makej_print_alternatives(+List, -JAlternatives)
makej_print_alternatives(T, _) :- var(T),
throw(error(instantiation_error,_)).
makej_print_alternatives([X|L], [Y|R]) :- !,
makej_print(X, Y),
makej_print_alternatives(L, R).
makej_print_alternatives([], []) :- !.
makej_print_alternatives(T, _) :-
throw(error(type_error(ir_alter, T),_)).
/*******************************************************************/
/* Constants */
/*******************************************************************/
% makej_print_const(+Const, -JConst)
makej_print_const(T, _) :- var(T),
throw(error(instantiation_error,_)).
makej_print_const(functor(F,L), 'new Compound'(G, 'new Object[]'(R))) :- !,
makej_print_const(F, G),
makej_print_args(L, H),
makej_print_set(H, R).
makej_print_const(site(F), 'new Cache'(G)) :- !,
makej_print_atom(F, G).
makej_print_const(link(Q), 'make_defined'('new Object[]'(R))) :- !,
makej_print_alternatives(Q, H),
makej_print_set(H, R).
makej_print_const(A, B) :- number(A), !,
makej_print_number(A, B).
makej_print_const(A, B) :- reference(A), !,
makej_print_reference(A, B).
makej_print_const(A, B) :- atom(A), !,
makej_print_atom(A, B).
makej_print_const(T, _) :-
throw(error(type_error(ir_const, T),_)).
% makej_print_args(+List, -JList)
makej_print_args([X|L], [Y|R]) :-
makej_print_const(X, Y),
makej_print_args(L, R).
makej_print_args([], []).
% makej_print_set(+List, -Set)
makej_print_set([], {}).
makej_print_set([X|Y], {Z}) :- makej_print_comma(Y, X, Z).
% makej_print_comma(+List, +Term -Comma)
makej_print_comma([], X, X).
makej_print_comma([X|Y], Z, (Z,T)) :- makej_print_comma(Y, X, T).
/*************************************************************/
/* Number Utility */
/*************************************************************/
makej_print_number(A, B) :- integer(A), !, crossj_escape_integer(A, B).
makej_print_number(A, A).
% crossj_escape_integer(+Integer, -JInteger)
crossj_escape_integer(A, A) :- -2147483648 =< A, A =< 2147483647, !.
crossj_escape_integer(A, 'new BigInteger'(B)) :-
atom_integer(H, 10, A),
atom_split(B, '', ['"', H, '"']).
/*************************************************************/
/* Reference Utility */
/*************************************************************/
% makej_print_reference(+Reference, -JReference)
makej_print_reference(0rNone, null) :- !.
makej_print_reference(0rFalse, false) :- !.
makej_print_reference(0rTrue, true) :- !.
makej_print_reference(A, _) :-
throw(error(domain_error(printable,A),_)).
/*************************************************************/
/* Atom Utility */
/*************************************************************/
% makej_print_atom(+Atom, -Atom)
makej_print_atom(X, Y) :-
atom_codes(X, L),
crossj_escape_codes(L, R, [0'"]),
atom_codes(Y, [0'"|R]).
% crossj_escape_codes(+List, -List, +List)
crossj_escape_codes([X|L]) -->
crossj_escape_code(X),
crossj_escape_codes(L).
crossj_escape_codes([]) --> [].
% crossj_escape_code(+Integer, -List, +List)
crossj_escape_code(X) --> {crossj_is_escape(Y, X)}, !, [0'\\, Y].
crossj_escape_code(X) --> {crossj_is_meta(X)}, !, [0'\\, X].
crossj_escape_code(X) --> {cross_is_cntrl(X)}, !, crossj_escape_code2(X).
crossj_escape_code(X) --> {cross_is_invalid(X)}, !, crossj_escape_code2(X).
crossj_escape_code(X) --> [X].
% crossj_escape_code(+Integer, -List, +List)
crossj_escape_code2(X) --> {X =< 0xFFFF}, !,
{atom_integer(J, 16, X), atom_codes(J, H), length(H, N), M is 4-N},
[0'\\, 0'u], cross_escape_zeros(M), cross_escape_codes2(H).
crossj_escape_code2(X) --> {crossj_high_surrogate(X, Y), crossj_low_surrogate(X, Z)},
crossj_escape_code2(Y), crossj_escape_code2(Z).
% crossj_is_escape(+Code, -Code)
crossj_is_escape(0'n, 0'\n).
crossj_is_escape(0't, 0'\t).
crossj_is_escape(0'b, 0'\b).
crossj_is_escape(0'f, 0'\f).
crossj_is_escape(0'r, 0'\r).
% crossj_is_meta(+Code)
crossj_is_meta(0'\').
crossj_is_meta(0'\").
crossj_is_meta(0'\\).
% crossj_high_surrogate(+Integer, -Integer)
crossj_high_surrogate(X, Y) :- Y is (X >> 10) + 0xD7C0.
% crossj_low_surrogate(+Integer, -Integer)
crossj_low_surrogate(X, Y) :- Y is (X /\ 0x3FF) + 0xDC00.
/*******************************************************************/
/* Decode Transpile Options */
/*******************************************************************/
% decode_transpilej_opts(+List, +Pair, -Pair)
decode_transpilej_opts(V, _, _) :- var(V),
throw(error(instantiation_error,_)).
decode_transpilej_opts([X|L], I, O) :- !,
decode_transpilej_opt(X, I, H),
decode_transpilej_opts(L, H, O).
decode_transpilej_opts([], H, H) :- !.
decode_transpilej_opts(L, _, _) :-
throw(error(type_error(list,L),_)).
% decode_transpilej_opt(+Option, +Pair, -Pair)
decode_transpilej_opt(V, _, _) :- var(V),
throw(error(instantiation_error,_)).
decode_transpilej_opt(main_entry(B), v(F,Y), v(G,Y)) :- !,
sys_opt_boolean(B, 1, F, G).
decode_transpilej_opt(defer_meta(B), v(F,Y), v(G,Y)) :- !,
sys_opt_boolean(B, 2, F, G).
decode_transpilej_opt(doge(A),v(X,_), v(X,A)) :- !,
sys_check_atom(A).
decode_transpilej_opt(O, _, _) :-
throw(error(type_error(transpilej_option,O),_)).