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