1/* 
    2   This file is part of the hashtbl library.
    3
    4   hashtbl is free software; you can redistribute it and/or modify it under
    5   the terms of the GNU LGPL. See README.md for details.
    6 */
    7
    8:- module(p_hashtbl, [
    9    empty_p_hashtbl/1,
   10    empty_p_hashtbl/2,
   11    p_hashtbl_put/4,
   12    p_hashtbl_set/4,
   13    p_hashtbl_get/3,
   14    p_hashtbl_get_all/3,
   15    p_hashtbl_get_default/5,
   16    p_hashtbl_delete/3,
   17    p_hashtbl_enumerate/3,
   18    p_hashtbl_to_list/2,
   19    list_to_p_hashtbl/2,
   20    list_to_p_hashtbl/3,
   21    p_hashtbl_map/3,
   22    p_hashtbl_fold/4,
   23    p_hashtbl_iter/2,
   24    p_hashtbl_unfold/2
   25    ]).

   40:- use_module(hashtbl/utils).

 empty_p_hashtbl(-Table) is det

Unifies Table with a newly created empty hash table of a default size.

   45empty_p_hashtbl(Table) :-
   46    hashtbl_default_size(Size),
   47    empty_p_hashtbl(Table, Size).

 empty_p_hashtbl(-Table, +Size) is det

Unifies Table with a newly created empty hash table with the number of buckets given by Size.

throws

- Type or domain error if Size is not a non-negative integer.

   55empty_p_hashtbl(Table, Size) :-
   56    Table = p_hashtbl([], BucketTerm),
   57    functor(BucketTerm, buckets, Size),
   58    term_variables(BucketTerm, Buckets),
   59    maplist(=([]), Buckets).

 copy_term_idx_arg(+Term, +Idx, +Arg, -Copy) is det

Unifies Copy with a copy of Term, except that Copy's argument at index Idx is Arg instead of Term's argument at index Idx. All other arguments are shared between Term and Copy.

   66copy_term_idx_arg(Term, Idx, Arg, Copy) :-
   67    functor(Term, Functor, Arity),
   68    functor(Copy, Functor, Arity),
   69    copy_arg_except(Term, 1, Arity, Idx, Arg, Copy).

 copy_arg_except(+Term, +J, +N, +Idx, +Arg, ?Copy) is det

Auxiliary predicate for copy_term_idx_arg/4. Unifies arguments J to N of Copy with the corresponding arguments of Term, except that it unifies argument Idx with Arg.

   76copy_arg_except(Term, J, N, I, Arg, Copy) :-
   77    (   J =< N
   78    ->  (   J = I
   79        ->  arg(I, Copy, Arg)
   80        ;   arg(J, Term, A),
   81            arg(J, Copy, A) ),
   82        J1 is J + 1,
   83        copy_arg_except(Term, J1, N, I, Arg, Copy)
   84    ;   true ).

 p_hashtbl_put(+Table, +Key, +Value, -TableOut) is det

TableOut is a hash table like Table, except that in TableOut Key is mapped to Value. If Key is already mapped to some values in Table, those mappings are present but shadowed by Value in TableOut.

   91p_hashtbl_put(Table, Key, Value, Table1) :-
   92    hashtbl_bucket(Table, Key, BucketTerm, BucketIdx, Bucket),
   93    (   selectchk(Key-Values, Bucket, Key-Values1, Bucket1)
   94    ->  Values1 = [Value|Values]
   95    ;   Bucket1 = [Key-[Value]|Bucket] ),
   96    copy_term_idx_arg(BucketTerm, BucketIdx, Bucket1, BucketTerm1),
   97    copy_term_idx_arg(Table, 2, BucketTerm1, Table1).

 p_hashtbl_set(+Table, +Key, +Value, -TableOut) is det

TableOut is a hash table like Table, except that in TableOut Key is mapped to Value. If Key is already mapped to some values in Table, the most recent one of those is replaced by Value. Other values for Key remain shadowed in TableOut.

  105p_hashtbl_set(Table, Key, Value, Table1) :-
  106    hashtbl_bucket(Table, Key, BucketTerm, BucketIdx, Bucket),
  107    (   selectchk(Key-[_Old|Rest], Bucket, Key-[Value|Rest], Bucket1)
  108    ->  true
  109    ;   Bucket1 = [Key-[Value]|Bucket] ),
  110    copy_term_idx_arg(BucketTerm, BucketIdx, Bucket1, BucketTerm1),
  111    copy_term_idx_arg(Table, 2, BucketTerm1, Table1).

 p_hashtbl_get(+Table, +Key, -Value) is semidet

Gets the most recently stored Value for Key in Table, if any. Fails if no values are stored for Key. There is no separate predicate for membership checks, use p_hashtbl_get(Table, Key, _) to test whether Key is present in Table.

  119p_hashtbl_get(Table, Key, Value) :-
  120    hashtbl_get(Table, Key, Value).

 p_hashtbl_get_all(+Table, +Key, -Value) is nondet

On backtracking, enumerates every Value associated with Key in Table. Fails if no values are stored for Key. The order of enumeration is the most recently added value for Key first (the same as the solution for p_hashtbl_get/3), then shadowed ones.

  128p_hashtbl_get_all(Table, Key, Value) :-
  129    hashtbl_get_all(Table, Key, Value).

 p_hashtbl_get_default(+Table, +Key, ?Default, -Value, -TableOut) is det

If Table contains an entry for Key, unifies Value with the corresponding value as in p_hashtbl_get/3 and TableOut with Table. Otherwise, unifies Value with Default and adds this value to the Table under Key (as by p_hashtbl_put/4) and unifies TableOut with the resulting table.

  137p_hashtbl_get_default(Table, Key, Default, Value, Table1) :-
  138    hashtbl_bucket(Table, Key, BucketTerm, BucketIdx, Bucket),
  139    (   memberchk(Key-[Value|_], Bucket)
  140    ->  Table1 = Table
  141    ;   Value = Default,
  142        Bucket1 = [Key-[Value]|Bucket],
  143        copy_term_idx_arg(BucketTerm, BucketIdx, Bucket1, BucketTerm1),
  144        copy_term_idx_arg(Table, 2, BucketTerm1, Table1) ).

 p_hashtbl_delete(!Table, +Key, -TableOut) is det

Deletes the most recent value stored under Key in Table, if any. Does nothing otherwise; succeeds always.

  150p_hashtbl_delete(Table, Key, Table1) :-
  151    hashtbl_bucket(Table, Key, BucketTerm, BucketIdx, Bucket),
  152    (   selectchk(Key-[_Old, Next | Rest], Bucket, Key-[Next|Rest], Bucket1)
  153    ->  true
  154    ;   selectchk(Key-[_Old], Bucket, Bucket1)
  155    ->  true
  156    ;   Bucket1 = Bucket ),
  157    copy_term_idx_arg(BucketTerm, BucketIdx, Bucket1, BucketTerm1),
  158    copy_term_idx_arg(Table, 2, BucketTerm1, Table1).

 p_hashtbl_enumerate(+Table, -Key, -Value) is nondet

On backtracking, enumerates every Key-Value pair stored in the Table. Fails if the table is empty. If several values are stored for the same key, their order of enumeration is most recent first, as in p_hashtbl_get_all/3. The ordering is otherwise unspecified.

If Key is ground, this behaves like p_hashtbl_get_all/3 for that Key. However, p_hashtbl_get_all/3 is more efficient in this case.

  169p_hashtbl_enumerate(Table, Key, Value) :-
  170    hashtbl_enumerate(Table, Key, Value).

 p_hashtbl_to_list(+Table, -Pairs) is det

Unifies Pairs with a list of all Key-Value pairs in the order as enumerated by p_hashtbl_enumerate/3.

  176p_hashtbl_to_list(Table, Pairs) :-
  177    hashtbl_to_list(Table, Pairs).

 list_to_p_hashtbl(+Pairs, -Table) is semidet

If Pairs is a list of Key-Value pairs, unifies Table with a corresponding hash table of a default size containing all those pairs. If there are several entries for the same Key in the list, later entries will shadow earlier ones in the Table.

  185list_to_p_hashtbl(Pairs, Table) :-
  186    hashtbl_default_size(Size),
  187    list_to_p_hashtbl(Pairs, Table, Size).

 p_hashtbl_put_pair(!Table, +Pair) is det

If Pair is a Key-Value pair, Value is put into the Table under Key as by p_hashtbl_put/3.

  193p_hashtbl_put_pair(Key-Value, Table, Table1) :-
  194    p_hashtbl_put(Table, Key, Value, Table1).

 list_to_p_hashtbl(+Pairs, -Table, +Size) is semidet

As list_to_p_hashtbl/2, but the hash table has an initial number of buckets given by Size.

throws

- Type or domain error if Size is not a non-negative integer.

  202list_to_p_hashtbl(Pairs, Table, Size) :-
  203    empty_p_hashtbl(Table0, Size),
  204    foldl(p_hashtbl_put_pair, Pairs, Table0, Table).

 p_hashtbl_map(+Table, :Goal, -TableOut) is nondet

For every Key and Value in Table, calls Goal(Key, Value, Value1) and unifies TableOut with a hash table containing all Key-Value1 pairs. Deterministic if Goal is deterministic. If Goal backtracks, p_hashtbl_map/3 enumerates several TableOut tables accordingly.

  212:- meta_predicate p_hashtbl_map(+, 3, *).  213p_hashtbl_map(Table, Goal, TableOut) :-
  214    hashtbl_map(Table, Goal, TableOut).

 p_hashtbl_fold(+Table, :Goal, +Acc, -Result) is nondet

Folds Goal over every Key and Value in the Table. Calls Goal(Key, Value, Acc, Result), using each call's Result as the next call's accumulator Acc, and unifying Result with the final call's Result. Deterministic if Goal is deterministic. If Goal backtracks, enumerates several results accordingly.

  223:- meta_predicate p_hashtbl_fold(+, 4, +, *).  224p_hashtbl_fold(Table, Goal, Acc, Result) :-
  225    hashtbl_fold(Table, Goal, Acc, Result).

 p_hashtbl_iter(+Table, :Goal) is nondet

Calls Goal(Key, Value) for every Key and Value stored in Table. This is useful to ensure that all entries satisfy some predicate, or for Goal's side effects. Deterministic if Goal is deterministic.

  232:- meta_predicate p_hashtbl_iter(+, 2).  233p_hashtbl_iter(Table, Goal) :-
  234    hashtbl_iter(Table, Goal).

 p_hashtbl_unfold(:Goal, -Table) is det

Unfolds the binary goal Goal into the Table: Unifies Table with a hash table containing a Key-Value entry for every solution of Goal(Key, Value). Table is empty if Goal has no solutions. Later solutions of Goal will shadow earlier ones in Table.

  242:- meta_predicate p_hashtbl_unfold(2, -).  243p_hashtbl_unfold(Goal, Table) :-
  244    (   setof(K-V, call(Goal, K, V), KVs)
  245    ->  true
  246    ;   KVs = [] ),
  247    list_to_p_hashtbl(KVs, Table).
  248
  249
  250:- begin_tests(p_hashtbl).  251
  252test(copy_1, true(Copy == f(c, b))) :-
  253    copy_term_idx_arg(f(a, b), 1, c, Copy).
  254
  255test(copy_2, true(Copy == f(a, c))) :-
  256    copy_term_idx_arg(f(a, b), 2, c, Copy).
  257
  258test(put_get_delete, true((One, Two) == (1, 2))) :-
  259    empty_p_hashtbl(T),
  260    p_hashtbl_put(T, x, 1, T1),
  261    p_hashtbl_put(T1, x, 2, T2),
  262    p_hashtbl_get(T2, x, Two),
  263    p_hashtbl_delete(T2, x, T3),
  264    p_hashtbl_get(T3, x, One),
  265    p_hashtbl_delete(T3, x, T4),
  266    \+ p_hashtbl_get(T4, x, _).
  267
  268test(put_get_all, all(X == [2, 1])) :-
  269    empty_p_hashtbl(T),
  270    p_hashtbl_put(T, x, 1, T1),
  271    p_hashtbl_put(T1, x, 2, T2),
  272    p_hashtbl_get_all(T2, x, X).
  273
  274test(put_get_default, true((X, Y) == (1, default(2)))) :-
  275    empty_p_hashtbl(T),
  276    p_hashtbl_put(T, x, 1, T1),
  277    p_hashtbl_get_default(T1, x, default(unused), X, T2),
  278    p_hashtbl_delete(T2, x, T3),
  279    \+ p_hashtbl_get(T3, x, _),
  280    p_hashtbl_get_default(T3, x, default(2), Y, _T4).
  281
  282test(put_set_delete, true((A, B, C, D) == (1, 2, 3, 1))) :-
  283    empty_p_hashtbl(T),
  284    p_hashtbl_put(T, x, 1, T1),
  285    p_hashtbl_get(T1, x, A),
  286    p_hashtbl_put(T1, x, 2, T2),
  287    p_hashtbl_get(T2, x, B),
  288    p_hashtbl_set(T2, x, 3, T3),
  289    p_hashtbl_get(T3, x, C),
  290    p_hashtbl_delete(T3, x, T4),
  291    p_hashtbl_get(T4, x, D),
  292    p_hashtbl_delete(T4, x, T5),
  293    \+ p_hashtbl_get(T5, x, _),
  294    p_hashtbl_delete(T5, x, T6),
  295    \+ p_hashtbl_get(T6, x, _).
  296
  297test(set_set_delete, true(X == 2)) :-
  298    empty_p_hashtbl(T),
  299    p_hashtbl_set(T, x, 1, T1),
  300    p_hashtbl_set(T1, x, 2, T2),
  301    p_hashtbl_get(T2, x, X),
  302    p_hashtbl_delete(T2, x, T3),
  303    \+ p_hashtbl_get(T3, x, _).
  304
  305test(enumerate, set(K-V == [x-1, y-2, z-3])) :-
  306    empty_p_hashtbl(T),
  307    p_hashtbl_put(T, x, 1, T1),
  308    p_hashtbl_put(T1, y, 2, T2),
  309    p_hashtbl_put(T2, z, 3, T3),
  310    p_hashtbl_enumerate(T3, K, V).
  311
  312test(to_list, true(Elements == [x-1, y-2, z-3])) :-
  313    empty_p_hashtbl(T),
  314    p_hashtbl_put(T, x, 1, T1),
  315    p_hashtbl_put(T1, y, 2, T2),
  316    p_hashtbl_put(T2, z, 3, T3),
  317    p_hashtbl_to_list(T3, List),
  318    sort(List, Elements).
  319
  320test(to_list_order, true(Elements == [x-3, x-2, x-1])) :-
  321    empty_p_hashtbl(T),
  322    p_hashtbl_put(T, x, 1, T1),
  323    p_hashtbl_put(T1, x, 2, T2),
  324    p_hashtbl_put(T2, x, 3, T3),
  325    p_hashtbl_to_list(T3, Elements).
  326
  327test(list_to, set(K-V == [x-1, y-2, z-3])) :-
  328    list_to_p_hashtbl([z-3, y-2, x-1], T),
  329    p_hashtbl_enumerate(T, K, V).
  330
  331test(map, set(K-V == [x-2, y-3, z-4])) :-
  332    list_to_p_hashtbl([z-3, y-2, x-1], T),
  333    p_hashtbl_map(T, utils:test_hashtbl_incr, T1),
  334    p_hashtbl_enumerate(T1, K, V).
  335
  336test(fold, true(Sum == 6)) :-
  337    list_to_p_hashtbl([z-3, y-2, x-1], T),
  338    p_hashtbl_fold(T, utils:test_hashtbl_sum, 0, Sum).
  339
  340test(fold_noncommutative,
  341     true(List == cons(x-1, cons(x-2, cons(x-3, nil))))) :-
  342    list_to_p_hashtbl([x-1, x-2, x-3], T),
  343    p_hashtbl_fold(T, utils:test_hashtbl_cons, nil, List).
  344
  345test(iter, true(Sum == sum(6))) :-
  346    list_to_p_hashtbl([z-3, y-2, x-1], T),
  347    Sum = sum(0),
  348    p_hashtbl_iter(T, utils:test_hashtbl_nb_sum(Sum)).
  349
  350test(unfold, true(Unfold = p_hashtbl_unfold(_Goal, _Table))) :-
  351    p_hashtbl_unfold(current_predicate, T),
  352    p_hashtbl_get(T, p_hashtbl_unfold, Unfold).
  353
  354test(unfold_order, all(Values == [b, a])) :-
  355    p_hashtbl_unfold(utils:test_k_ab_table, T),
  356    p_hashtbl_get_all(T, k, Values).
  357
  358test(unfold_empty, true(Elements == [])) :-
  359    p_hashtbl_unfold(utils:always_false, T),
  360    p_hashtbl_to_list(T, Elements).
  361
  362test(backtracking, [true(Elements == [])]) :-
  363    empty_p_hashtbl(T),
  364    (   p_hashtbl_put(T, a, b, _T1),
  365        false
  366    ;   p_hashtbl_put(T, c, d, _T2),
  367        false
  368    ;   p_hashtbl_put(T, e, f, _T3) ),
  369    p_hashtbl_to_list(T, List),
  370    sort(List, Elements).
  371
  372:- end_tests(p_hashtbl).