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

/**
 * table(I):
 * table(I, O):
 * The directive succeeds. As a side effect the predicate I
 * is registered for tabling, preparing a query cache, preparing
 * an answer cache and creating a wrapper. Subsequent clauses
 * for the predicate will be called from the wrapper. The
 * binary predicate allows specifying tabling options.
 */
% term_expansion(+Clause, -Clause)
:- multifile(term_expansion/2).
term_expansion(T, R) :- nonvar(T), T = (:- D),
   nonvar(D), D = table(F/N), !,
   functor(P, F, N),
   sys_make_tabling(P, C, 0),
   R = [(:- multifile('$TABLE'/2)),
        (:- discontiguous('$TABLE'/2)),
        (:- dynamic('$TABLE'/2)),
        '$TABLE'(F,N) | C].
term_expansion(T, R) :- nonvar(T), T = (:- D),
   nonvar(D), D = table(F/N, Opts), !,
   functor(P, F, N),
   sys_table_opts(Opts, 0, Flags),
   sys_make_tabling(P, C, Flags),
   R = [(:- multifile('$TABLE'/2)),
        (:- discontiguous('$TABLE'/2)),
        (:- dynamic('$TABLE'/2)),
        '$TABLE'(F,N) | C].
term_expansion(T, (J :- B)) :- nonvar(T), T = (H :- B),
   functor(H, F, N),
   clause('$TABLE'(F, N),true), !,
   sys_make_pred(H, '_i', J).
term_expansion(H, J) :-
   functor(H, F, N),
   clause('$TABLE'(F, N),true), !,
   sys_make_pred(H, '_i', J).

/**
 * abolish_all_tables:
 * abolish_table_pred(I):
 * The predicate succeeds. As a side effected the cached queries and
 * the cached answers of tabled predicates are removed. The unary
 * predicate allows specifying a predicate indicator.
 */
% abolish_all_tables
abolish_all_tables :-
   abolish_table_pred(_).

% abolish_table_pred(+Indicator)
abolish_table_pred(F/N) :- !,
   sys_abolish_tables(F, N).
abolish_table_pred(F) :-
   sys_abolish_tables(F, _).

% sys_abolish_tables(+Atom, +Integer)
sys_abolish_tables(F, N) :-
   clause('$TABLE'(F, N), true),
   functor(P, F, N),
   sys_make_pred(P, '_k', K),
   retractall(K),
   sys_make_pred(P, '_r', I),
   retractall(I),
   fail.
sys_abolish_tables(_, _).

/****************************************************************/
/* Functor Utility                                              */
/****************************************************************/

% sys_make_tabling(+Callable, -Clauses, +Integer)
sys_make_tabling(P, [D1, D2, C1, C2], Flags) :-
   sys_make_pred(P, '_i', J),
   sys_make_pred(P, '_k', K),
   sys_make_pred(P, '_r', I),
   sys_make_decl(K, D1, Flags),
   sys_make_decl(I, D2, Flags),
   sys_make_absent(K, G1),
   sys_make_absent(I, G2),
   /* if novel query, compute and store novel answers */
   C1 = (P :- G1, J, G2, fail),
   /* retrieve answers */
   C2 = (P :- !, I).

% sys_make_absent(+Callable, -Goal)
sys_make_absent(K, (G1, G2)) :-
   /* lookup unit */
   G1 = (\+ K),
   /* store unit */
   G2 = assertz(K).

% sys_make_pred(+Callable, +Atom, -Callable)
sys_make_pred(P, A, Q) :-
   P =.. [F|L],
   atom_join(['sys_',F,A], G),
   Q =.. [G|L].

% sys_make_decl(+Callable, -Clauses, +Integer) :-
sys_make_decl(K, [D1, D2], Flags) :- Flags /\ 1 =\= 0, !,
   functor(K, F, N),
   D1 = (:- dynamic(F/N)),
   D2 = (:- prehash(F/N)).
sys_make_decl(K, D1, _) :-
   functor(K, F, N),
   D1 = (:- dynamic(F/N)).

/***************************************************************/
/* Decode Table Options                                        */
/***************************************************************/

% sys_table_opts(+List, +Integer, -Integer)
sys_table_opts(V, _, _) :- var(V),
   throw(error(instantiation_error,_)).
sys_table_opts([X|L], I, O) :- !,
   sys_table_opt(X, I, H),
   sys_table_opts(L, H, O).
sys_table_opts([], H, H) :- !.
sys_table_opts(L, _, _) :-
   throw(error(type_error(list,L),_)).

% sys_table_opt(+Option, +Integer, -Integer)
sys_table_opt(V, _, _) :- var(V),
   throw(error(instantiation_error,_)).
sys_table_opt(hash(B), F, G) :- !,
   sys_opt_boolean(B, 1, F, G).
sys_table_opt(O, _, _) :-
   throw(error(domain_error(table_option,O),_)).