/**
 * 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(compat)).
:- ensure_loaded(library(hiord)).
:- ensure_loaded(library(cyclic)).
:- ensure_loaded(library(util/sequence)).
:- ensure_loaded(library(tester/fancy)).
:- ensure_loaded(library(tester/time)).

/***************************************************************/
/* Listing Clauses                                             */
/***************************************************************/

/**
 * listing:
 * listing(I):
 * The predicate succeeds. As a side effect the user clauses of
 * the user predicates are listed. The unary predicate allows
 * specifying a predicate indicator.
 */
% listing
listing :-
   listing(_).

% listing(+Indicator)
listing(I) :-
   current_output(Stream),
   sys_listing(I, Stream).

% sys_listing(+Indicator, +Stream)
sys_listing(F/N, Stream) :- !,
   sys_listing_pattern(F, N, Stream).
sys_listing(F, Stream) :-
   sys_listing_pattern(F, _, Stream).

% sys_listing_pattern(+Atom, +Integer, +Stream)
sys_listing_pattern(F, N, Stream) :-
   call_nth(sys_listing_indicator(F, N), C),
   (C > 1 -> nl(Stream); true),
   sys_listing_pred(F, N, Stream),
   fail.
sys_listing_pattern(_, _, _).

% sys_listing_pred(+Atom, +Integer, +Stream)
sys_listing_pred(F, N, Stream) :-
   sys_listing_prop(F, N, D),
   sys_listing_write((:- D), Stream),
   sys_answer_period(Stream),
   fail.
sys_listing_pred(F, N, Stream) :-
   functor(H, F, N),
   sys_user_ref(H, C),
   kb_clause_data(C, H, O, L),
   sys_decode_body(L, R),
   sys_untrans_body(R, O, 1, B),
   sys_listing_write((H :- B), Stream),
   sys_answer_period(Stream),
   fail.
sys_listing_pred(_, _, _).

/****************************************************************/
/* Clauses Filter                                               */
/****************************************************************/

% sys_listing_indicator(-Atom, +Integer)
sys_listing_indicator(F, N) :-
   current_predicate(F/N),
   \+ sys_user_stop(F, N),
   functor(H, F, N),
   \+ \+ (sys_listing_prop(F, N, _); sys_user_ref(H, _)).

% sys_listing_prop(+Atom, +Integer, -Atom)
sys_listing_prop(F, N, multifile(F/N)) :-
   once((sys_predprop(F, N, sys_multifile(P)),
   \+ sys_user_nope(P))).
sys_listing_prop(F, N, R) :-
   kb_pred_link(F, N, P),
   kb_link_flags(P, D),
   sys_listing_flag(F, N, D, R).

% sys_listing_flag(+Atom, +Integer, +Integer, -Callable)
sys_listing_flag(F, N, D, R) :-
   D /\ 1 =\= 0, R = dynamic(F/N).
sys_listing_flag(F, N, D, R) :-
   D /\ 16 =\= 0, R = prehash(F/N).

/****************************************************************/
/* Gensym Variables                                             */
/****************************************************************/

% sys_listing_write(+Term, +Stream)
sys_listing_write(T, Stream) :- (T = (C :- true); T = C), !,
   term_variables(C, L),
   term_singletons(C, A),
   sys_listing_names(L, A, 0, N),
   print_term(Stream, C, [variable_names(N), anonymous(A),
      format(true), numbervars(true), quoted(true)]).

% sys_answer_period(+Stream)
sys_answer_period(S) :-
   sys_safe_space(S, '.', 0),
   put_atom(S, '.'),
   nl(S).

% sys_listing_names(+List, +List, +Integer, -Pairs)
sys_listing_names([], _, _, []).
sys_listing_names([X|L], [Y|R], K, S) :- X == Y, !,
   sys_listing_names(L, R, K, S).
sys_listing_names([X|L], R, K, [B=X|S]) :-
   sys_numbervars_name(K, B),
   J is K+1,
   sys_listing_names(L, R, J, S).

/*************************************************************/
/* Unattended Queries                                        */
/*************************************************************/

% sys_expand_unattended(+Goal, +Map, -Goal)
sys_expand_unattended(V, _, _) :- var(V),
    throw(error(instantiation_error,_)).
sys_expand_unattended((V, _), _, _) :- var(V),
    throw(error(instantiation_error,_)).
sys_expand_unattended((trace, Query), Map, Query2) :- !,
    Query2 = sys_trace(Query, 0-Map).
sys_expand_unattended(Query, _, Query).

% sys_query_unattended(+Goal, +Map)
sys_query_unattended(Query, Map) :-
   '$MARK'(X),
   Query,
   '$MARK'(Y),
   (X == Y -> !, sys_answer_final(Map);
   sys_answer_display(Map) -> fail; !).
sys_query_unattended(_, _) :-
   sys_answer_fail.

% sys_answer_final(+Map)
sys_answer_final(Map) :-
   current_output(Stream),
   sys_answer_show(Map, Stream),
   sys_answer_period(Stream).

% sys_answer_display(+Map)
sys_answer_display(Map) :-
   current_output(Stream),
   sys_answer_show(Map, Stream),
   put_atom(Stream, ';'),
   nl(Stream).

% sys_answer_fail
sys_answer_fail :-
   current_output(Stream),
   put_atom(Stream, 'fail'),
   sys_answer_period(Stream).

/****************************************************************/
/* Answert Substitution                                         */
/****************************************************************/

% sys_answer_show(+Map, +Stream)
sys_answer_show(Map, Stream) :-
   sys_answer_split(Map, Names, Answer),
   acyclic_factorized(Answer, Pairs),
   sys_keyvalues_list(Pairs, Answer2, []),
   sys_answer_inline(Answer2, Answer2, Answer3),
   sys_display_list(Answer3, Conj),
   sys_answer_write(Conj, Names, Stream).

% sys_answer_split(+Map, -Map, -Map)
sys_answer_split([N=V|L], [N=V|P], Q) :-
   sys_marked_at(N, 0, [23]),
   sys_marked_at(N, 1, [1,3,23]), !,
   sys_answer_split(L, P, Q).
sys_answer_split([N=T|L], [N=V|P], [V=T|Q]) :-
   sys_answer_split(L, P, Q).
sys_answer_split([], [], []).

% sys_keyvalues_list(+Pairs, -List, +List)
sys_keyvalues_list([]) --> [].
sys_keyvalues_list([X|L]) -->
   sys_values_list(X),
   sys_keyvalues_list(L).

% sys_values_list(+List, -List, +List)
sys_values_list([]) --> [].
sys_values_list([X|L]) -->
   [X],
   sys_values_list(L).

% sys_answer_inline(+Map, +Map, -Map)
sys_answer_inline([V=T|P], M, Q) :- var(T), sys_find_var(T, M, W), V == W, !,
   V = T, sys_answer_inline(P, M, Q).
sys_answer_inline([V=T|P], M, [T=V|Q]) :- var(T), !,
   sys_answer_inline(P, M, Q).
sys_answer_inline([X|P], M, [X|Q]) :-
   sys_answer_inline(P, M, Q).
sys_answer_inline([], _, []).

% sys_answer_write(+Term, +Map, +Stream)
sys_answer_write(C, Map, Stream) :-
   term_singletons((Map,C), A),
   print_term(Stream, C, [variable_names(Map), anonymous(A),
      numbervars(true), quoted(true)]).