Home Page
Site Map
Login/out
Message Board
Download(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.
*/
/**
* initialization(G):
* The predicate succeeds whenever G succeeds.
*/
initialization(G) :- G.
/*************************************************************/
/* Prolog Launch */
/*************************************************************/
/**
* sys_launch(R):
* The predicate launches the remainder arguments.
*/
% sys_launch
sys_launch :-
current_prolog_flag(argv, L),
sys_trap(sys_launch(L),
Error, sys_print_error(Error)).
% sys_launch(+List)
sys_launch([]) :-
sys_banner,
sys_toplevel.
sys_launch([H|T]) :-
set_prolog_flag(argv, T),
ensure_loaded(H).
% sys_banner
sys_banner :-
current_prolog_flag(version_data, Version),
Version =.. [_, Major, Minor, Patch, [date(Time)|_]|_],
get_string('format.date', Format),
sys_time_atom(Format, Time, Atom),
current_output(S),
sys_print_message(banner(player, Major, Minor, Patch, Atom), S), nl,
sys_print_message(banner(copyright), S), nl.
/*************************************************************/
/* Top-Level */
/*************************************************************/
/**
* sys_toplevel:
* The predicate succeeds. As a side effect, a REPL is run.
*/
% sys_toplevel
sys_toplevel :-
current_input(Stream),
os_task_current(Task),
setup_once_cleanup(
asserta(sys_including(user, Task, Stream)),
sys_toplevel_prompt(Stream),
once(retract(sys_including(user, Task, Stream)))).
% sys_toplevel_prompt(+Stream)
sys_toplevel_prompt(Stream) :-
repeat,
put_atom('?- '),
flush_output,
sys_trap(read_term(Stream, Goal, [variable_names(Map)]),
Error, (sys_print_error(Error), fail)),
(Goal == end_of_file -> true;
sys_trap(sys_query_attended(Goal, Map),
Error, sys_print_error(Error)),
fail), !.
/*************************************************************/
/* Toplevel Queries */
/*************************************************************/
% sys_query_attended(+Goal, +Map)
sys_query_attended(Query, Map) :-
'$MARK'(X),
Query,
'$MARK'(Y),
sys_answer_show(Map),
(X == Y -> !, sys_listing_period;
sys_ask_abort -> !; fail).
sys_query_attended(_, _) :-
put_atom('fail'), sys_listing_period.
% sys_ask_abort
sys_ask_abort :-
flush_output,
get_atom(0'\n, Atom),
Atom \== ';\n'.
/****************************************************************/
/* Filter & Show Variables */
/****************************************************************/
% sys_answer_show(+Map)
sys_answer_show(Map) :-
reverse(Map, Map2),
sys_filter_names(Map, Map2, Map3),
sys_answer_map(Map3, Map2).
% sys_filter_names(+Map, +Map, -Map)
sys_filter_names([N=V|L], Q, R) :-
var(V), sys_find_var(V, Q, M), M = N, !,
sys_filter_names(L, Q, R).
sys_filter_names([P|L], Q, [P|R]) :-
sys_filter_names(L, Q, R).
sys_filter_names([], _, []).
% sys_answer_map(+Map, +Map)
sys_answer_map([P,Q|L], Map) :- !,
sys_answer_eq(P, Map),
put_atom(', '),
sys_answer_map([Q|L], Map).
sys_answer_map([P], Map) :-
sys_answer_eq(P, Map).
sys_answer_map([], _) :-
put_atom('true').
% sys_answer_eq(+Pair, +Map)
sys_answer_eq(N=V, Map) :-
sys_var_quoted(N, 1, M),
put_atom(M),
put_atom(' = '),
sys_answer_term(V, Map).
% sys_answer_term(+Term, +Map)
sys_answer_term(V, Map) :- acyclic_term(V), !,
write_term(V, [priority(699), variable_names(Map), quoted(true)]).
sys_answer_term(_, _) :-
put_atom('<cyclic term>').
/***************************************************************/
/* Listing Clauses */
/***************************************************************/
/**
* listing:
* listing(I):
* The predicate lists the user clauses of the user predicates.
* The unary predicate allows specifying a predicate indicator.
*/
% listing
listing :-
listing(_).
% listing(+Indicator)
listing(I) :-
current_output(Stream),
listing(I, Stream).
% listing(+Indicator, +Stream)
listing(I, T) :- \+ ground(I), !,
sys_listing_pattern(I, T).
listing(F/N, T) :- !,
sys_check_atom(F),
sys_check_integer(N),
sys_listing_user(F/N, T).
listing(I, _) :-
throw(error(type_error(predicate_indicator,I),_)).
% sys_listing_pattern(+Indicator, +Stream)
sys_listing_pattern(I, T) :-
current_predicate(I),
sys_listing_user(I, T),
fail.
sys_listing_pattern(_,_).
% sys_listing_user(+Indicator, +Stream)
sys_listing_user(F/N, T) :-
\+ sys_listing_stop(F, N),
sys_listing_multifile(F, N, T),
sys_listing_dynamic(F, N, T),
functor(H, F, N),
kb_clause_ref(H, 0, C),
kb_clause_shard(C, S),
\+ sys_listing_stop(S),
kb_clause_data(C, H, O, L),
sys_decode_body(L, R),
sys_untrans_body(R, O, B),
sys_listing_show(H, B, T),
fail.
sys_listing_user(_,_).
% sys_listing_multifile(+Atom, +Integer, +Stream)
sys_listing_multifile(F, N, T) :-
sys_predprop(F, N, sys_multifile(S)),
\+ sys_listing_stop(S), !,
sys_listing_write((:- multifile F/N), T).
sys_listing_multifile(_, _, _).
% sys_listing_dynamic(+Atom, +Integer, +Stream)
sys_listing_dynamic(F, N, T) :-
kb_pred_link(F, N, Q),
kb_link_flags(Q, O),
O /\ 1 =\= 0, !,
sys_listing_write((:- dynamic F/N), T).
sys_listing_dynamic(_, _, _).
% sys_listing_show(+Term, +Goal, +Stream)
sys_listing_show(H, true, T) :- !,
sys_listing_write(H, T).
sys_listing_show(H, B, T) :-
sys_listing_write((H :- B), T).
% sys_listing_write(+Term, +Stream)
sys_listing_write(C, T) :-
term_variables(C, V),
term_singletons(C, A),
sys_listing_names(V, A, 0, N),
write_term(T, C, [quoted(true), variable_names(N), format(true)]),
sys_listing_period(T).
% sys_listing_names(+List, +List, +Integer, -Pairs)
sys_listing_names([], _, _, []).
sys_listing_names([X|L], A, K, ['_'=X|R]) :- member(Y,A), Y==X, !,
sys_listing_names(L, A, K, R).
sys_listing_names([X|L], A, K, [N=X|R]) :-
sys_listing_name(K, N),
J is K+1,
sys_listing_names(L, A, J, R).
% sys_listing_name(+Integer, -Atom)
sys_listing_name(K, N) :- K < 26, !,
J is K+0'A,
char_code(N, J).
sys_listing_name(K, N) :-
J is (K rem 26)+0'A,
char_code(C, J),
H is K//26+1,
atom_integer(A, 10, H),
atom_concat(C, A, N).
% sys_listing_period
sys_listing_period :-
current_output(Stream),
sys_listing_period(Stream).
% sys_listing_period(+Stream)
sys_listing_period(Stream) :-
sys_safe_code(Stream, 0'.),
nl(Stream).
% sys_listing_stop(+Atom)
sys_listing_stop(system).
sys_listing_stop(Path) :-
current_prolog_flag(system_url, Base),
file_directory_name(Base, Dir),
sub_atom(Path, 0, _, _, Dir).
% sys_listing_stop(+Atom, -Integer)
sys_listing_stop(sys_op, 5).
sys_listing_stop(sys_source, 3).
sys_listing_stop(sys_srcprop, 2).
sys_listing_stop(sys_predprop, 3).
sys_listing_stop(sys_lastpred, 3).
sys_listing_stop(sys_including, 3).
sys_listing_stop(sys_emulated, 2).
/****************************************************************/
/* Other Texts */
/****************************************************************/
% strings(+Atom, +Atom, -Atom)
:- multifile strings/3.
strings('banner.player', de, 'Dogelog Spieler, Prolog zum Mond, ~.~.~ (~~)').
strings('banner.copyright', de, '(c) 1985-2024, XLOG Technologies AG, Schweiz').
strings('banner.player', '', 'Dogelog Player, Prolog to the Moon, ~.~.~ (~~)').
strings('banner.copyright', '', '(c) 1985-2024, XLOG Technologies AG, Switzerland').