Prolog "silkworm"
/**
* 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),_)).