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