Home Page
Site Map
Login/out
Message Board
Download(c) 2005-2025 XLOG Technologies AG
/**
* 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)).
/**
* Compounds used:
* - 'H'(M,S): Value holder of a hash map M
* and its total number of elements S.
* - 'T'(L1,..,Lm): The hash map holding open
* lists L1,..,Lm.
*/
/***************************************************************/
/* Pairs Access */
/***************************************************************/
/**
* hash_enum(T, P):
* The predicate succeeds in P with the key value pairs
* from the hash table T.
*/
% hash_enum(+Hash, -Pair)
hash_enum('H'(T,_), P) :-
functor(T, _, N),
between(1, N, I),
arg(I, T, L),
sys_open_member(P, L).
% sys_open_member(-Term, +List)
sys_open_member(_, L) :- var(L), !, fail.
sys_open_member(X, [X|_]).
sys_open_member(X, [_|L]) :- sys_open_member(X, L).
/**
* hash_pairs(T, L):
* The predicate succeeds in L with the key value pair
* list from the hash table T.
*/
% hash_pairs(+Hash, -Pairs)
hash_pairs(H, L) :- var(H), !,
hash_new(H),
(member(K-V, L), hash_set(H, K, V), fail; true).
hash_pairs('H'(T, _), L) :-
T =.. [_|A],
sys_hash_pairs(A, L, []).
% sys_hash_pairs(+List, -Pairs, +Pairs)
sys_hash_pairs([]) --> [].
sys_hash_pairs([L|A]) -->
sys_open_pairs(L),
sys_hash_pairs(A).
% sys_open_pairs(+Entries, -Pairs, +Pairs)
sys_open_pairs(V) --> {var(V)}, !.
sys_open_pairs([X|L]) --> [X],
sys_open_pairs(L).
/**
* hash_size(T, S):
* The predicate succeeds in S with the number of key value
* pairs of the hash table T.
*/
% hash_size(+Hash, -Integer)
hash_size('H'(_, S), S).
/***************************************************************/
/* Basic Access */
/***************************************************************/
/**
* hash_new(T):
* The predicate succeeds in R with a new hash table.
*/
% hash_new(-Hash)
hash_new(R) :-
R = 'H'(_, _),
change_arg(2, R, 0),
functor(T, 'T', 1),
change_arg(1, R, T).
/**
* hash_current(T, K, V):
* The predicate succeeds in V with the value for the key K
* in the hash table T.
*/
% hash_current(+Hash, +Term, -Term)
hash_current('H'(T,_), K, V) :-
term_hash(K, H),
functor(T, _, N),
I is H mod N+1,
arg(I, T, L),
sys_open_member(P, L),
arg(1, P, K), !,
arg(2, P, V).
/***************************************************************/
/* Non-Backtracking Modification */
/***************************************************************/
/**
* hash_set(T, K, V):
* The predicate succeeds. As a side effect the hash table T
* is extended by the key value pair K,V if the key is new or
* else the value for the K is replaced by V.
*/
% hash_set(+Hash, +Term, +Term)
hash_set(M, K, V) :-
arg(1, M, T),
term_hash(K, H),
functor(T, _, N),
I is H mod N+1,
arg(I, T, L),
P = _-_,
change_arg(1, P, K),
change_arg(2, P, V),
sys_open_set(P, L, I, T), !,
arg(2, M, S),
S2 is S+1,
change_arg(2, M, S2),
(4*S2 =< 3*N -> true;
N2 is N*2,
functor(T2, 'T', N2),
sys_table_rehash(T, N, T2, N2),
change_arg(1, M, T2)).
hash_set(_, _, _).
% sys_open_set(-Term, +List, +Integer, +Compound)
sys_open_set(X, L, I, T) :- var(L), !,
R = [_|_], change_arg(1, R, X), change_arg(I, T, R).
sys_open_set(K-V, [P|_], _, _) :- P = K-_, !, change_arg(2, P, V), fail.
sys_open_set(X, R, _, _) :-
R = [_|L], sys_open_set(X, L, 2, R).
/**
* hash_add(T, K, V):
* The predicate succeeds if the key is new. As a side effect
* the hash table T is extended by the key value pair K,V.
*/
% hash_add(+Hash, +Term, +Term)
hash_add(M, K, V) :-
arg(1, M, T),
term_hash(K, H),
functor(T, _, N),
I is H mod N+1,
arg(I, T, L),
P = _-_,
change_arg(1, P, K),
change_arg(2, P, V),
sys_open_add(P, L, I, T),
arg(2, M, S),
S2 is S+1,
change_arg(2, M, S2),
(4*S2 =< 3*N -> true;
N2 is N*2,
functor(T2, 'T', N2),
sys_table_rehash(T, N, T2, N2),
change_arg(1, M, T2)).
% sys_open_add(-Term, +List, +Integer, +Compound)
sys_open_add(X, L, I, T) :- var(L), !,
R = [_|_], change_arg(1, R, X), change_arg(I, T, R).
sys_open_add(K-_, [K-_|_], _, _) :- !, fail.
sys_open_add(X, R, _, _) :-
R = [_|L], sys_open_add(X, L, 2, R).
/***************************************************************/
/* Non-Backtracking Helper */
/***************************************************************/
% sys_table_rehash(+Table, +Integer, +Table, +Integer)
sys_table_rehash(T, N, T2, N2) :-
between(1, N, J),
arg(J, T, R),
sys_open_member(P, R),
arg(1, P, K),
term_hash(K, H),
I is H mod N2+1,
arg(I, T2, L),
sys_open_conc(P, L, I, T2),
fail.
sys_table_rehash(_, _, _, _).
% sys_open_conc(-Term, +List, +Integer, +Compound)
sys_open_conc(X, L, I, T) :- var(L), !,
R = [_|_], change_arg(1, R, X), change_arg(I, T, R).
sys_open_conc(X, R, _, _) :-
R = [_|L], sys_open_conc(X, L, 2, R).
/***************************************************************/
/* Backtracking Modification */
/***************************************************************/
/**
* hash_add(T, K, V, T2):
* The predicate succeeds if the key is new. It unifies T2 with
* the hash table T is extended by the key value pair K,V.
*/
% hash_add(+Hash, +Term, +Term, -Hash)
hash_add('H'(T,S), K, V, 'H'(T2,S2)) :-
functor(T, _, N),
term_hash(K, H),
I is H mod N+1,
arg(I, T, L),
sys_open_add(K-V, L),
S2 is S+1,
(4*S2 =< 3*N -> T2 = T;
N2 is N*2,
functor(T2, 'T', N2),
T =.. [_|R],
sys_table_rehash(R, T2, N2)).
% sys_open_add(-Term, +List)
sys_open_add(X, L) :- var(L), !, L = [X|_].
sys_open_add(K-_, [K-_|_]) :- !, fail.
sys_open_add(X, [_|L]) :- sys_open_add(X, L).
/***************************************************************/
/* Backtracking Helpers */
/***************************************************************/
% sys_table_rehash(+List, +Table, +Integer)
sys_table_rehash([], _, _).
sys_table_rehash([X|L], T, N) :-
sys_bouquet_rehash(X, T, N),
sys_table_rehash(L, T, N).
% sys_bouquet_rehash(+List, +Table, +Integer)
sys_bouquet_rehash(L, _, _) :- var(L), !.
sys_bouquet_rehash([K-V|R], T, N) :-
term_hash(K, H),
I is H mod N+1,
arg(I, T, L),
sys_open_conc(K-V, L),
sys_bouquet_rehash(R, T, N).
% sys_open_conc(-Term, +List)
sys_open_conc(X, L) :- var(L), !, L = [X|_].
sys_open_conc(X, [_|L]) :- sys_open_conc(X, L).