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

         
/***************************************************************/
         
/* 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),
         
   sys_listing(I, Stream).
         

         
% sys_listing(+Indicator, +Stream)
         
sys_listing(I, T) :- \+ ground(I), !,
         
   sys_listing_pattern(I, T).
         
sys_listing(F/N, T) :- !,
         
   sys_check_atom(F),
         
   sys_check_integer(N),
         
   sys_listing_user(F/N, T).
         
sys_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_answer_period(T).
         

         
% sys_listing_names(+List, +List, +Integer, -Pairs)
         
sys_listing_names([], _, _, []).
         
sys_listing_names([X|L], [Y|R], K, ['_'=X|S]) :- X==Y, !,
         
   sys_listing_names(L, R, K, S).
         
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_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).
         
sys_listing_stop(sys_init_goal, 1).
         

         
/****************************************************************/
         
/* Term Decode                                                  */
         
/****************************************************************/
         

         
/**
         
 * sys_decode_body(L, R):
         
 * The predicate succeeds in R with the unlinked goal list L.
         
 */
         
% sys_decode_body(+List, -List)
         
sys_decode_body([], []).
         
sys_decode_body([X|L], [Z|R]) :-
         
   sys_decode_callable(X, Y),
         
   sys_decode_goal(Y, Z),
         
   sys_decode_body(L, R).
         

         
% sys_decode_callable(+Callable, -Callable)
         
sys_decode_callable(X, X) :- var(X), !.
         
sys_decode_callable(X, Y) :- functor(X, Q, _), ir_is_site(Q), !,
         
   ir_site_name(Q, F), sys_decode_site(X, Y, F).
         
sys_decode_callable(X, X).
         

         
% sys_decode_site(+Callable, -Callable, +Atom)
         
sys_decode_site(X, Y, F) :- compound(X), !,
         
   X =.. [_|L],
         
   Y =.. [F|L].
         
sys_decode_site(_, F, F).
         

         
/**
         
 * sys_decode_goal(F, G):
         
 * The predicate succeeds in G with the unlinked goal F.
         
 */
         
% sys_decode_goal(+Term, -Term)
         
sys_decode_goal(X, call(X)) :- var(X), !.
         
sys_decode_goal(X, R) :- functor(X, Q, _), kb_is_link(Q), !,
         
   sys_decode_link(X, R).
         
sys_decode_goal('$EVAL'(E,V), V is F) :- !,
         
   sys_decode_expr(E, F).
         
sys_decode_goal(E =:= F, G =:= H) :- !,
         
   sys_decode_expr(E, G),
         
   sys_decode_expr(F, H).
         
sys_decode_goal(E =\= F, G =\= H) :- !,
         
   sys_decode_expr(E, G),
         
   sys_decode_expr(F, H).
         
sys_decode_goal(E < F, G < H) :- !,
         
   sys_decode_expr(E, G),
         
   sys_decode_expr(F, H).
         
sys_decode_goal(E > F, G > H) :- !,
         
   sys_decode_expr(E, G),
         
   sys_decode_expr(F, H).
         
sys_decode_goal(E =< F, G =< H) :- !,
         
   sys_decode_expr(E, G),
         
   sys_decode_expr(F, H).
         
sys_decode_goal(E >= F, G >= H) :- !,
         
   sys_decode_expr(E, G),
         
   sys_decode_expr(F, H).
         
sys_decode_goal(X, X).
         

         
% sys_decode_link(+Callable, -Callable)
         
sys_decode_link(X, '$ALT'(P)) :-
         
   findall(C, kb_clause_ref(X, 0, C), L),
         
   sys_decode_alternatives(L, X, P).
         

         
% sys_decode_alternatives(+List, +Callable, -List)
         
sys_decode_alternatives([], _, []).
         
sys_decode_alternatives([C|L], X, ['$SEQ'(U,W)|R]) :-
         
   kb_clause_data(C, X, U, V),
         
   sys_decode_body(V, W),
         
   sys_decode_alternatives(L, X, R).
         

         
/**
         
 * sys_decode_expr(F, G):
         
 * The predicate succeeds in G with the unlinked expression F.
         
 */
         
% sys_decode_expr(+Expr, -Expr)
         
sys_decode_expr(V, V) :- var(V), !.
         
sys_decode_expr(X, Y) :- functor(X, Q, _), ir_is_site(Q), !,
         
   ir_site_name(Q, F), sys_decode_compute(X, Y, F).
         
sys_decode_expr(C, D) :- compound(C), !,
         
   C =.. [F|L],
         
   sys_decode_args(L, R),
         
   D =.. [F|R].
         
sys_decode_expr(A, A).
         

         
% sys_decode_compute(+Callable, -Callable, +Atom)
         
sys_decode_compute(X, Y, F) :- compound(X), !,
         
   X =.. [_|L],
         
   sys_decode_args(L, R),
         
   Y =.. [F|R].
         
sys_decode_compute(_, F, F).
         

         
% sys_decode_args(+List, -List)
         
sys_decode_args([], []).
         
sys_decode_args([X|L], [Y|R]) :-
         
   sys_decode_expr(X, Y),
         
   sys_decode_args(L, R).
         

         
/*******************************************************************/
         
/* Foreign Predicates                                              */
         
/*******************************************************************/
         

         
% term_singletons(X, Y):
         
% defined in foreign(tester/asmlib)
         

         
:- ensure_loaded(foreign(tester/asmlib)).