/**
 * 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)).
:- ensure_loaded(library(hiord)).

/**
 * Compounds used:
 * - 'H'(M,S,C,E): Value holder of a hash map M and its
 *       total number of elements S, plus the hash code
 *       closure C and the equals closure E.
 * - '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):
 * hash_new(T, C, E):
 * The predicate succeeds in R with a new hash table. The ternary
 * predicate allows specifying a term hash C and a term equality E.
 */
% hash_new(-Hash)
hash_new(R) :-
   hash_new(R, term_hash, ==).

% hash_new(-Hash, +Code, +Equal)
hash_new(R, C, E) :-
   ir_site_new(C, C2),
   ir_site_new(E, E2),
   R = 'H'(_,_,C2,E2),
   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,_,C,E), K, V) :-
   call(C, K, H),
   functor(T, _, N),
   I is H mod N+1,
   arg(I, T, L),
   sys_open_member(P, L),
   arg(1, P, J),
   call(E, J, 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) :- M = 'H'(T,S,C,E),
   call(C, 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, E), !,
   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, C),
      change_arg(1, M, T2)).
hash_set(_, _, _).

% sys_open_set(+Term, +List, +Integer, +Compound, +Equal)
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|_], _, _, E) :- P = J-_, call(E, J, K), !,
   change_arg(2, P, V), fail.
sys_open_set(X, R, _, _, E) :-
   R = [_|L], sys_open_set(X, L, 2, R, E).

/**
 * 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) :- M = 'H'(T,S,C,_),
   call(C, 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),
   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, C),
      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(X, R, _, _) :-
   R = [_|L], sys_open_add(X, L, 2, R).

/***************************************************************/
/* Non-Backtracking Helper                                     */
/***************************************************************/

% sys_table_rehash(+Table, +Integer, +Table, +Integer, +Code)
sys_table_rehash(T, N, T2, N2, C) :-
   between(1, N, J),
   arg(J, T, R),
   sys_open_member(P, R),
   arg(1, P, K),
   call(C, K, H),
   I is H mod N2+1,
   arg(I, T2, L),
   sys_open_add(P, L, I, T2),
   fail.
sys_table_rehash(_, _, _, _, _).

/***************************************************************/
/* Backtracking Modification                                   */
/***************************************************************/

/**
 * hash_add(T, K, V, T2):
 * The predicate succeeds. It unifies T2 with the hash table T
 * that is extended by the key value pair K,V.
 */
% hash_add(+Hash, +Term, +Term, -Hash)
hash_add('H'(T,S,C,E), K, V, 'H'(T2,S2,C,E)) :-
   functor(T, _, N),
   call(C, 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, C)).

% sys_open_add(-Term, +List)
sys_open_add(X, L) :- var(L), !, L = [X|_].
sys_open_add(X, [_|L]) :- sys_open_add(X, L).

/***************************************************************/
/* Backtracking Helpers                                        */
/***************************************************************/

% sys_table_rehash(+List, +Table, +Integer, +Code)
sys_table_rehash([], _, _, _).
sys_table_rehash([X|L], T, N, C) :-
   sys_bouquet_rehash(X, T, N, C),
   sys_table_rehash(L, T, N, C).

% sys_bouquet_rehash(+List, +Table, +Integer, +Code)
sys_bouquet_rehash(L, _, _, _) :- var(L), !.
sys_bouquet_rehash([K-V|R], T, N, C) :-
   call(C, K, H),
   I is H mod N+1,
   arg(I, T, L),
   sys_open_add(K-V, L),
   sys_bouquet_rehash(R, T, N, C).