Prolog "session"
/**
* 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.
*/
:- ensure_loaded(library(tester/fancy)).
:- ensure_loaded(library(tester/tools)).
/********************************************************************/
/* abort/0 and exit/0 */
/********************************************************************/
/**
* abort:
* The predicate signals to abort the current query.
*/
% abort
abort :- throw(error(system_error(user_abort), _)).
/**
* exit:
* The predicate signals to abort the current session.
*/
% exit
exit :- throw(error(system_error(user_exit), _)).
/***************************************************************/
/* Make Command */
/***************************************************************/
/**
* make:
* The predicate ensures that all used Prolog text sources are
* reloaded if their last modified has changed, or removed if
* they are not anymore used.
*/
% make
make :-
sys_make_unmark,
sys_replay_file(user),
sys_make_reclaim.
% sys_make_unmark
sys_make_unmark :-
sys_source(Path, LastModified, _),
\+ sys_make_nope(Path),
retractall(sys_source(Path, _, _)),
assertz(sys_source(Path, LastModified, 0)),
fail.
sys_make_unmark.
% sys_make_nope(+Atom)
sys_make_nope(Path) :-
current_prolog_flag(foreign_ext, Ext),
sub_atom(Path, _, _, 0, Ext).
sys_make_nope(Path) :-
current_prolog_flag(system_url, Base),
file_directory_name(Base, Dir),
sub_atom(Path, 0, _, _, Dir).
% sys_make_reclaim :-
sys_make_reclaim :-
retract(sys_source(Path, _, 0)),
sys_clear_file(Path),
fail.
sys_make_reclaim.
/***************************************************************/
/* Replay File */
/***************************************************************/
% sys_replay_file(+Atom)
sys_replay_file(Parent) :-
sys_srcprop(Parent, sys_link(Path)),
catch(sys_check_file(Path, _), Error, sys_print_error(Error)),
fail.
sys_replay_file(_).
/***************************************************************/
/* Clear File */
/***************************************************************/
% sys_clear_file(+Atom)
sys_clear_file(Path) :-
retractall(sys_op(_, _, _, _, Path)),
retractall(sys_srcprop(Path, _)),
sys_predprop(F, N, sys_usage(Path)),
(sys_predprop(F, N, sys_usage(Other)),
Path \== Other ->
sys_shrink_pred(F, N, Path);
sys_destroy_pred(F, N)),
fail.
sys_clear_file(_).
% sys_destroy_pred(+Atom, +Integer)
sys_destroy_pred(F, N) :-
retractall(sys_predprop(F, N, _)),
kb_pred_destroy(F, N).
% sys_shrink_pred(+Atom, +Integer, +Atom)
sys_shrink_pred(F, N, Path) :-
retractall(sys_predprop(F, N, sys_usage(Path))),
retractall(sys_predprop(F, N, sys_multifile(Path))),
functor(H, F, N),
kb_clause_ref(H, 4, C),
kb_clause_shard(C, Path),
kb_clause_remove(C, 1),
fail.
sys_shrink_pred(_, _, _).
/*************************************************************/
/* version/0 and prolog/0 */
/*************************************************************/
/**
* version:
* The predicate succeeds. As a side effect, a banner is printed.
*/
% version
version :-
current_output(Stream),
current_prolog_flag(version, Version),
Major is Version // 10000,
Minor is (Version // 100) rem 100,
Patch is Version rem 100,
current_prolog_flag(host_info, Host),
format_atom('~d.~d.~d, ~w', [Major,Minor,Patch,Host], Atom),
put_message(Stream, banner(runtime, Atom)), nl,
put_message(Stream, banner(copyright)), nl.
/**
* prolog:
* The predicate succeeds. As a side effect, a REPL is run. See
* documentation for available commands.
*/
% prolog
prolog :-
current_input(Stream),
current_task(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,
sys_trap(sys_init_goals, Error2, sys_print_user(Error2)),
current_output(W),
put_atom(W, '?- '),
flush_output(W),
sys_trap(sys_next_query(Stream), Error,
(sys_print_user(Error), fail)), !.
% sys_next_query(+Stream)
sys_next_query(Stream) :-
read_term(Stream, Query, [variable_names(Map)]),
current_output(W2),
ir_object_set(W2, offset, 0),
(Query == end_of_file -> true;
sys_expand_attended(Query, Map, Query2),
sys_query_attended(Query2, Map),
fail).
/*************************************************************/
/* Attended Queries */
/*************************************************************/
% sys_expand_attended(+Goal, +Map, -Goal)
sys_expand_attended(V, _, _) :- var(V),
throw(error(instantiation_error,_)).
sys_expand_attended((V, _), _, _) :- var(V),
throw(error(instantiation_error,_)).
sys_expand_attended((trace, Query), Map, Query2) :- !,
Query2 = sys_trace(Query, 1-Map).
sys_expand_attended(Query, _, Query).
% sys_query_attended(+Goal, +Map)
sys_query_attended(Query, Map) :-
'$MARK'(X),
Query,
'$MARK'(Y),
(X == Y -> !, sys_answer_final(Map);
sys_answer_prompt(Map) -> fail; !).
sys_query_attended(_, _) :-
sys_answer_fail.
% sys_answer_prompt(+Map)
sys_answer_prompt(Map) :-
repeat,
current_output(W),
sys_answer_show(Map, W),
flush_output(W),
get_atom(Atom, []),
current_output(W2),
ir_object_set(W2, offset, 0),
(Atom == ';\n' ->
current_task(Task),
retractall(sys_trace_skip(Task, _));
Atom == '\n' ->
true;
put_message(W, session(help)), nl, fail),
!, Atom == ';\n'.
% sys_print_user(+Error)
sys_print_user(Error) :-
sys_chain_head(Error, error(system_error(user_exit),_)),
sys_raise(Error).
sys_print_user(Error) :-
sys_print_error(Error).
/****************************************************************/
/* Meta Debugger */
/****************************************************************/
:- dynamic(sys_trace_skip/2).
/**
* sys_trace(G, M):
* The predicate succeeds whenever G succeeds inside an interactive
* Byrd Box debugger and the options M. The interactive debugger is
* started in creep mode. See documentation for available commands.
*/
% sys_trace(+Goal, +Pair)
sys_trace(A, M) :-
current_task(Task),
retractall(sys_trace_skip(Task, _)),
sys_trace_call(A, 0, M).
% sys_trace_call(+Goal, +Integer, +Pair)
sys_trace_call(V, _, _) :- var(V),
throw(error(instantiation_error, _)).
sys_trace_call(A, K, M) :-
sys_trace_body(A, B),
'$MARK'(C),
sys_trace_conj(B, C, K, M).
% sys_trace_conj(+Goal, +Mark, +Integer, +Pair)
sys_trace_conj(V, _, _, _) :- var(V),
throw(error(instantiation_error,_)).
sys_trace_conj(true, _, _, _) :- !.
sys_trace_conj(!, C, _, _) :- !,
'$CUT'(C).
sys_trace_conj(call(A), _, K, M) :- !,
sys_trace_call(A, K, M).
sys_trace_conj((A,B), C, K, M) :- !,
sys_trace_conj(A, C, K, M), sys_trace_conj(B, C, K, M).
sys_trace_conj((A;B), C, K, M) :- !, '$MARK'(D),
sys_trace_disj((A;B), C, D, K, M).
sys_trace_conj((A->B), C, K, M) :- !, '$MARK'(D),
sys_trace_disj((A->B), C, D, K, M).
sys_trace_conj(call(A,A1), _, K, M) :- !,
A =.. [F|L], append(L,[A1],R), B =.. [F|R],
sys_trace_call(B, K, M).
sys_trace_conj(call(A,A1,A2), _, K, M) :- !,
A =.. [F|L], append(L,[A1,A2],R), B =.. [F|R],
sys_trace_call(B, K, M).
sys_trace_conj(call(A,A1,A2,A3), _, K, M) :- !,
A =.. [F|L], append(L,[A1,A2,A3],R), B =.. [F|R],
sys_trace_call(B, K, M).
sys_trace_conj(call(A,A1,A2,A3,A4), _, K, M) :- !,
A =.. [F|L], append(L,[A1,A2,A3,A4],R), B =.. [F|R],
sys_trace_call(B, K, M).
sys_trace_conj(call(A,A1,A2,A3,A4,A5), _, K, M) :- !,
A =.. [F|L], append(L,[A1,A2,A3,A4,A5],R), B =.. [F|R],
sys_trace_call(B, K, M).
sys_trace_conj(call(A,A1,A2,A3,A4,A5,A6), _, K, M) :- !,
A =.. [F|L], append(L,[A1,A2,A3,A4,A5,A6],R), B =.. [F|R],
sys_trace_call(B, K, M).
sys_trace_conj(call(A,A1,A2,A3,A4,A5,A6,A7), _, K, M) :- !,
A =.. [F|L], append(L,[A1,A2,A3,A4,A5,A6,A7],R), B =.. [F|R],
sys_trace_call(B, K, M).
sys_trace_conj(catch(A,E,B), _, K, M) :- !,
catch(sys_trace_call(A, K, M), E, sys_trace_call(B, K, M)).
sys_trace_conj(H, _, K, M) :- sys_hidden_goal(H), !,
(sys_trace_defined(H) -> sys_trace_hidden(H, K, M); H).
sys_trace_conj(H, _, K, M) :- sys_trace_defined(H), !,
sys_trace_resolve(H, K, M).
sys_trace_conj(H, _, K, M) :-
sys_trace_native(H, K, M).
% sys_trace_disj(+Term, +Mark, +Mark, +Integer, +Pair)
sys_trace_disj(V, _, _, _, _) :- var(V),
throw(error(instantiation_error,_)).
sys_trace_disj((A;B), C, D, K, M) :- !,
(sys_trace_disj(A, C, D, K, M); sys_trace_disj(B, C, D, K, M)).
sys_trace_disj((A->B), C, D, K, M) :- !,
sys_trace_call(A, K, M), '$CUT'(D), sys_trace_conj(B, C, K, M).
sys_trace_disj(A, C, _, K, M) :-
sys_trace_conj(A, C, K, M).
% sys_trace_hidden(+Term, +Integer, +Pair)
sys_trace_hidden(H, K, M) :- J is K+1,
'$MARK'(C), sys_trace_clause(H, B), sys_trace_conj(B, C, J, M).
/****************************************************************/
/* Byrd Box Interaction */
/****************************************************************/
% sys_trace_resolve(+Term, +Integer, +Pair)
sys_trace_resolve(H, K, M) :- J is K+1,
sys_trace_in(H, K, M),
'$MARK'(C), sys_trace_clause(H, B), sys_trace_conj(B, C, J, M), '$MARK'(D),
sys_trace_out(H, K, M),
(C == D -> !; true).
% sys_trace_native(+Term, +Integer, +Pair)
sys_trace_native(H, K, M) :-
sys_trace_in(H, K, M),
'$MARK'(C), H, '$MARK'(D),
sys_trace_out(H, K, M),
(C == D -> !; true).
% sys_trace_in(+Term, +Integer, +Pair)
sys_trace_in(G, K, M) :-
sys_trace_prompt('CALL', G, K, M).
sys_trace_in(G, K, M) :-
sys_trace_prompt('FAIL', G, K, M), fail.
% sys_trace_out(+Term, +Integer, +Pair)
sys_trace_out(G, K, M) :-
sys_trace_prompt('EXIT', G, K, M).
sys_trace_out(G, K, M) :-
sys_trace_prompt('REDO', G, K, M), fail.
% sys_trace_prompt(+Atom, +Term, +Integer, +Pair)
sys_trace_prompt(_, _, K, _) :-
current_task(Task),
sys_trace_skip(Task, J),
J < K, !.
sys_trace_prompt(L, G, _, 0-M) :- !,
write(' '), write(L), write(' '),
display_term(G, [variable_names(M),
numbervars(true), quoted(true)]),
nl.
sys_trace_prompt(L, G, K, 1-M) :-
repeat,
current_output(W),
write(W, ' '), write(W, L), write(W, ' '),
display_term(W, G, [variable_names(M),
numbervars(true), quoted(true)]),
write(W, ' '), flush_output(W),
get_atom(Atom, []),
current_output(W2),
ir_object_set(W2, offset, 0),
(Atom = 'a\n' -> abort;
Atom = 'l\n' -> current_task(Task),
retractall(sys_trace_skip(Task, _)),
assertz(sys_trace_skip(Task, -1));
Atom = 's\n' -> current_task(Task),
retractall(sys_trace_skip(Task, _)),
assertz(sys_trace_skip(Task, K));
Atom = '\n' -> current_task(Task),
retractall(sys_trace_skip(Task, _));
put_message(W, debugger(help)),
nl(W), fail), !.
/****************************************************************/
/* Clause Helpers */
/****************************************************************/
% sys_trace_body(+Goal, -Goal)
sys_trace_body(A, C) :- ir_is_site(A), !,
ir_site_name(A, B),
sys_trace_body(B, C).
sys_trace_body(A, call(A)) :- var(A), !.
sys_trace_body((A,B), (X,Y)) :- !,
sys_trace_body(A, X),
sys_trace_body(B, Y).
sys_trace_body((A;B), (X;Y)) :- !,
sys_trace_body(A, X),
sys_trace_body(B, Y).
sys_trace_body((A->B), (X->Y)) :- !,
sys_trace_body(A, X),
sys_trace_body(B, Y).
sys_trace_body(A, A) :-
must_be(callable, A).
% sys_trace_defined(+Term)
sys_trace_defined(H) :-
functor(H, F, N),
kb_pred_link(F, N, P), !,
kb_link_flags(P, D),
A is D /\ 15,
(A = 0; A = 1).
sys_trace_defined(_).
% sys_trace_clause(+Term, -Goal)
sys_trace_clause(H, B) :-
kb_clause_ref(H, 8, C),
kb_clause_data(C, P, O, L),
sys_decode_body(L, R),
sys_untrans_body(R, O, 1, B),
H = P.
/****************************************************************/
/* Goal Hiding */
/****************************************************************/
% sys_hidden_goal(+Goal)
sys_hidden_goal(G) :- var(G), !, fail.
sys_hidden_goal(fail).
sys_hidden_goal(nonvar(_)).
sys_hidden_goal(var(_)).
sys_hidden_goal(_ = _).
sys_hidden_goal(_ =.. _).
sys_hidden_goal(G) :-
functor(G, F, _),
sub_atom(F, 0, _, _, 'sys_').
sys_hidden_goal(G) :-
functor(G, F, N), sys_meta_args(F, N, M),
sys_hidden_meta(M, G).
% sys_hidden_meta(+List, +Callable)
sys_hidden_meta(M, C) :-
C =.. [_|L],
sys_hidden_params(M, L).
% sys_hidden_params(+List, +List)
sys_hidden_params([], []).
sys_hidden_params([T|M], [X|L]) :-
sys_hidden_param(T, X),
sys_hidden_params(M, L).
% sys_hidden_param(+Atom, +Term)
sys_hidden_param(t, _).
sys_hidden_param(c, X) :- sys_hidden_clause(X).
sys_hidden_param(p, G) :- sys_hidden_goal(G).
% sys_hidden_clause(+Clause, -Clause)
sys_hidden_clause(T) :- nonvar(T), T = (G :- _), !,
functor(G, F, _),
sub_atom(F, 0, _, _, 'sys_').
sys_hidden_clause(G) :-
functor(G, F, _),
sub_atom(F, 0, _, _, 'sys_').
/****************************************************************/
/* Other Texts */
/****************************************************************/
% strings(+Atom, +Atom, -Atom)
:- multifile(strings/3).
strings('banner.runtime', de, 'Dogelog Spieler ~w').
strings('banner.copyright', de, '(c) 1985-2026, XLOG Technologies AG, Schweiz').
strings('session.help', de, ';⏎:\tZu nächstem Port oder Antwortsubstitution kriechen.\n\
⏎:\tDie aktuelle Anfrage terminieren.').
strings('debugger.help', de, 'a⏎:\tDen Debugger abbrechen und zum Top-level zurückkehren.\n\
l⏎:\tZur nächstem Antwortsubstitution springen.\n\
s⏎:\tZum nächstem Port des aktuellen Ziels hopsen.\n\
⏎:\tZu nächstem Port oder Antwortsubstitution kriechen.').
strings('banner.runtime', '', 'Dogelog Player ~w').
strings('banner.copyright', '', '(c) 1985-2026, XLOG Technologies AG, Switzerland').
strings('session.help', '', ';⏎:\tCreep to next port or answer substitution.\n\
⏎:\tTerminate the current query.').
strings('debugger.help', '', 'a⏎:\tAbort the debugger and return to top-level.\n\
l⏎:\tLeap to the next answer substitution.\n\
s⏎:\tSkip to the next port of the current goal.\n\
⏎:\tCreep to next port or answer substitution.').