/**
* 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.
*/
/***************************************************************/
/* Dynamic Database */
/***************************************************************/
/**
* dynamic(I): [ISO 7.4.2.1]
* The predicate succeeds. As a side effect, it touches the predicate I
* and ensures that it is dynamic.
*/
% dynamic(+Indicator)
dynamic(F/N) :- !,
must_be(atom, F),
must_be(integer, N),
sys_style_indicator(F, N),
kb_pred_touch(F, N, 1).
dynamic(I) :-
throw(error(type_error(predicate_indicator,I),_)).
/**
* prehash(I):
* The predicate succeeds. As a side effect, it touches the predicate I
* and ensures that it is uses a pre-computed hash index.
*/
% prehash(+Indicator)
prehash(F/N) :- !,
must_be(atom, F),
must_be(integer, N),
sys_style_indicator(F, N),
kb_pred_touch(F, N, 4).
prehash(I) :-
throw(error(type_error(predicate_indicator,I),_)).
/**
* asserta(C): [ISO 8.9.1]
* The predicate succeeds. As a side effect, the clause C
* is inserted at the top.
*/
% asserta(+Clause)
asserta(T) :- nonvar(T), T = (H :- B), !,
sys_trans_body(B, nothing, M, 0, R, []),
H =.. [W|L],
sys_clause_ossify(L, R, M, W, C),
sys_clause_add(C, 1).
asserta(T) :-
T =.. [W|L],
sys_clause_ossify(L, [], nothing, W, C),
sys_clause_add(C, 1).
/**
* assertz(C): [ISO 8.9.2]
* The predicate succeeds. As a side effect, the clause C
* is inserted at the bottom.
*/
% assertz(+Clause)
assertz(T) :- nonvar(T), T = (H :- B), !,
sys_trans_body(B, nothing, M, 0, R, []),
H =.. [W|L],
sys_clause_ossify(L, R, M, W, C),
sys_clause_add(C, 3).
assertz(T) :-
T =.. [W|L],
sys_clause_ossify(L, [], nothing, W, C),
sys_clause_add(C, 3).
/**
* clause(H, B): [ISO 8.8.1]
* The predicate succeeds with the asserted clauses
* that unify H :- B.
*/
% clause(+Callable, -Goal)
clause(H, B) :-
kb_clause_ref(H, 2, C),
kb_clause_data(C, H, O, L),
sys_untrans_body(L, O, 0, A),
A = B.
/**
* retract(C): [ISO 8.9.3]
* The predicate succeeds with the clauses that unify C.
* As a side effect the clause is removed.
*/
% retract(+Clause)
retract(T) :- nonvar(T), T = (H :- B), !,
kb_clause_ref(H, 3, C),
kb_clause_data(C, H, O, L),
sys_untrans_body(L, O, 0, A),
A = B,
kb_clause_remove(C, 0).
retract(H) :-
kb_clause_ref(H, 3, C),
kb_clause_data(C, H, _, []),
kb_clause_remove(C, 0).
/**
* retractall(H): [TC2 8.9.5]
* The predicate succeeds. As a side effect the clauses
* that unify the head H are removed.
*/
% retractall(+Callable)
retractall(H) :-
kb_clause_ref(H, 7, C),
kb_clause_head(C, H),
kb_clause_remove(C, 1),
fail.
retractall(_).
/**
* abolish(I): [ISO 8.9.4]
* The predicate succeeds. As a side effect, the
* predicate I is destroyed.
*/
% abolish(+Indicator)
abolish(F/N) :- !,
sys_abolish(F, N).
abolish(I) :-
throw(error(type_error(predicate_indicator,I),_)).
% sys_abolish(+Atom, +Integer)
sys_abolish(F, N) :-
kb_pred_link(F, N, P),
kb_link_flags(P, D),
D /\ 1 =:= 0,
throw(error(permission_error(modify, static_procedure, F/N),_)).
sys_abolish(F, N) :-
retractall(sys_predprop(F, N, _)),
kb_pred_destroy(F, N).
/***************************************************************/
/* Predicate Property */
/***************************************************************/
% sys_predprop(-Atom, -Integer, -Term)
:- dynamic(sys_predprop/3).
/**
* current_predicate(I): [ISO 8.8.2]
* The predicate succeeds in I with current predicate indicators.
*/
% current_predicate(-Indicator)
current_predicate(F/N) :- (var(F); var(N)), !,
kb_pred_list(L),
member(F/N, L).
current_predicate(F/N) :- !,
kb_pred_link(F, N, _).
current_predicate(I) :-
throw(error(type_error(predicate_indicator,I),_)).
/**
* predicate_property(I, P):
* The predicate succeeds in P with the properties of the predicate indicator I.
*/
% predicate_property(+Indicator, -Term)
predicate_property(F/N, P) :- (var(F); var(N)), !,
current_predicate(F/N),
sys_predprop_get(F, N, P).
predicate_property(F/N, P) :- !,
sys_predprop_get(F, N, P).
predicate_property(I, _) :-
throw(error(type_error(predicate_indicator,I),_)).
% sys_predprop_get(+Atom, +Integer, -Term)
sys_predprop_get(F, N, R) :-
kb_pred_link(F, N, P),
kb_link_flags(P, D),
A is D /\ 15,
sys_predprop_flag(A, B),
R = B.
sys_predprop_get(F, N, P) :-
sys_predprop(F, N, P).
% sys_predprop_flag(+Integer, -Term)
sys_predprop_flag(0, static) :- !.
sys_predprop_flag(1, dynamic) :- !.
sys_predprop_flag(_, built_in).
/***************************************************************/
/* Prolog Flags */
/***************************************************************/
% sys_emulated(+Atom, -Atom)
:- dynamic(sys_emulated/2).
sys_emulated(argv, []).
sys_emulated(sys_locale, 'en_GB').
sys_emulated(sys_color, 'normal').
/**
* set_prolog_flag(K, V): [ISO 8.17.2]
* The built-in succeeds. As a side effect the value of
* the flag K is changed to V.
*/
% set_prolog_flag(+Atom, +Term)
set_prolog_flag(K, V) :-
must_be(atom, K),
sys_prolog_flag_set(K, V), !.
set_prolog_flag(K, _) :-
throw(error(domain_error(prolog_flag,K),_)).
% sys_prolog_flag_get(+Atom, +Term)
sys_prolog_flag_set(argv, D) :-
retractall(sys_emulated(argv, _)),
assertz(sys_emulated(argv, D)).
sys_prolog_flag_set(sys_locale, D) :-
retractall(sys_emulated(sys_locale, _)),
assertz(sys_emulated(sys_locale, D)).
sys_prolog_flag_set(sys_color, D) :-
retractall(sys_emulated(sys_color, _)),
assertz(sys_emulated(sys_color, D)).
sys_prolog_flag_set(base_url, D) :-
os_set_workdir(D).
sys_prolog_flag_set(stage, D) :-
dg_set_stage(D).
sys_prolog_flag_set(partition, D) :-
dg_set_partition(D).
sys_prolog_flag_set(K, _) :-
sys_prolog_flag_get(K, _),
throw(error(permission_error(modify, flag, K),_)).
/**
* current_prolog_flag(K, V): [ISO 8.17.2]
* The built-in succeeds for the value V of the flag K. See
* documentation for the available flags.
*/
% current_prolog_flag(-Atom, -Term)
current_prolog_flag(K, V) :- var(K), !,
sys_prolog_flag_get(K, V).
current_prolog_flag(K, V) :-
must_be(atom, K),
sys_prolog_flag_get(K, W), !,
V = W.
current_prolog_flag(K, _) :-
throw(error(domain_error(prolog_flag,K),_)).
% sys_prolog_flag_get(-Atom, -Term)
sys_prolog_flag_get(argv, D) :- sys_emulated(argv, D).
sys_prolog_flag_get(sys_locale, L) :- sys_emulated(sys_locale, L).
sys_prolog_flag_get(sys_color, L) :- sys_emulated(sys_color, L).
sys_prolog_flag_get(base_url, D) :- os_get_workdir(D).
sys_prolog_flag_get(stage, D) :- dg_get_stage(D).
sys_prolog_flag_get(partition, D) :- dg_get_partition(D).
sys_prolog_flag_get(single_quotes, atom).
sys_prolog_flag_get(double_quotes, codes).
sys_prolog_flag_get(back_quotes, variable).
sys_prolog_flag_get(dialect, dogelog).
sys_prolog_flag_get(version, 20203).
sys_prolog_flag_get(use_strict, off).
sys_prolog_flag_get(max_code, 0x10FFFF).
sys_prolog_flag_get(max_arity, 2147483647).
sys_prolog_flag_get(async_mode, D) :- dg_get_flags(F),
sys_prolog_flag_decode(F, 1, D).
sys_prolog_flag_get(allow_yield, D) :- dg_get_flags(F),
sys_prolog_flag_decode(F, 8, D).
sys_prolog_flag_get(import_async, on).
sys_prolog_flag_get(prop_async, on).
sys_prolog_flag_get(read_async, on).
sys_prolog_flag_get(state_async, D) :- dg_get_flags(F),
sys_prolog_flag_decode(F, 128, D).
sys_prolog_flag_get(Key, Value) :- var(Key), !,
os_get_host(Map),
ir_object_keys(Map, Keys),
member(Key, Keys),
ir_object_current(Map, Key, Value).
sys_prolog_flag_get(Key, Value) :-
os_get_host(Map),
ir_object_current(Map, Key, Value).
% sys_prolog_flag_decode(-Integer, -Integer, -Atom)
sys_prolog_flag_decode(F, M, D) :- F /\ M =\= 0, !, D = on.
sys_prolog_flag_decode(_, _, off).
/****************************************************************/
/* List Utility */
/****************************************************************/
/**
* vars_intersection(S, T, R):
* The predicate succeeds in R with the intersection of S and T.
*/
% vars_intersection(+Term, +Term, -List)
vars_intersection(P, Q, R) :-
vars_subtract(P, Q, H),
vars_subtract(P, H, R).
/**
* vars_subtract(S, T, R):
* The predicate succeeds in R with the subtract of S and T.
*/
% vars_subtract(+Term, +Term, -List)
vars_subtract(P, Q, R) :-
term_variables(Q, A),
term_variables(Q+P, B),
append(A, R, B).
/*******************************************************************/
/* Initialize Environment */
/*******************************************************************/
% sys_including(-Atom, +Task, -Stream)
:- dynamic(sys_including/3).
:- os_get_gestalt(M),
ir_object_current(M, sys_color, C),
set_prolog_flag(sys_color, C),
ir_object_current(M, sys_locale, L),
set_prolog_flag(sys_locale, L),
ir_object_current(M, argv, A),
set_prolog_flag(argv, A).