/**
 * 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.').