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(nb_hashtbl, [
    9    empty_nb_hashtbl/1,
   10    empty_nb_hashtbl/2,
   11    nb_hashtbl_put/3,
   12    nb_hashtbl_set/3,
   13    nb_hashtbl_get/3,
   14    nb_hashtbl_get_all/3,
   15    nb_hashtbl_get_default/4,
   16    nb_hashtbl_delete/2,
   17    nb_hashtbl_enumerate/3,
   18    nb_hashtbl_to_list/2,
   19    list_to_nb_hashtbl/2,
   20    list_to_nb_hashtbl/3,
   21    nb_hashtbl_map/3,
   22    nb_hashtbl_fold/4,
   23    nb_hashtbl_iter/2,
   24    nb_hashtbl_unfold/2
   25    ]).

Impure hash tables

This module defines impure (imperative) hash tables that allow destructive updates.

The predicates in this module use destructive non-backtrackable updates to implement the hash table. The basic operation used internally to implement changes to the hash table is nb_linkarg/3. Use with care.

The user should take care never to copy a non-backtrackable hash table. This includes never using asserta/1 or assertz/1 to store it in the database. If the table is to be stored in a global variable, nb_linkval/2 should be used for the purpose.

author
- Gergö Barany <gergo@tud.at>
license
- LGPL

/

   46:- use_module(hashtbl/utils).
 empty_nb_hashtbl(-Table) is det
Unifies Table with a newly created empty hash table of a default size.
   51empty_nb_hashtbl(Table) :-
   52    hashtbl_default_size(Size),
   53    empty_nb_hashtbl(Table, Size).
 empty_nb_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.
   61empty_nb_hashtbl(Table, Size) :-
   62    Table = nb_hashtbl(meta(0), BucketTerm),
   63    functor(BucketTerm, buckets, Size),
   64    term_variables(BucketTerm, Buckets),
   65    maplist(=([]), Buckets).
 nb_hashtbl_put(!Table, +Key, +Value) is det
Puts the Value into the Table at Key. If there are already values stored for Key, this new value will shadow them until it is deleted from the table.
   72nb_hashtbl_put(Table, Key, Value) :-
   73    hashtbl_load(Table, Load),
   74    hashtbl_bucket(Table, Key, BucketTerm, BucketIdx, Bucket),
   75    (   member(KeyValues, Bucket),
   76        KeyValues = Key-Values
   77    ->  nb_linkarg(2, KeyValues, [Value|Values]),
   78        Load1 = Load
   79    ;   nb_linkarg(BucketIdx, BucketTerm, [Key-[Value]|Bucket]),
   80        Load1 is Load + 1 ),
   81    nb_hashtbl_maybe_resize(Table, Load1).
 nb_hashtbl_set(!Table, +Key, +Value) is det
Sets the Value associated with Key in Table. If there are already values stored for Key in Table, the most recent one will is overwritten. If that entry shadowed earlier entries for Key, those remain shadowed and unchanged.
   89nb_hashtbl_set(Table, Key, Value) :-
   90    hashtbl_load(Table, Load),
   91    hashtbl_bucket(Table, Key, BucketTerm, BucketIdx, Bucket),
   92    (   KeyValues = Key-Values,
   93        memberchk(KeyValues, Bucket)
   94    ->  (   Values = [_OldValue|_]
   95        ->  nb_linkarg(1, Values, Value)
   96        ;   assertion(Values = [_|_]) ),
   97        Load1 = Load
   98    ;   nb_linkarg(BucketIdx, BucketTerm, [Key-[Value]|Bucket]),
   99        Load1 is Load + 1 ),
  100    nb_hashtbl_maybe_resize(Table, Load1).
 nb_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 nb_hashtbl_get(Table, Key, _) to test whether Key is present in Table.
  108nb_hashtbl_get(Table, Key, Value) :-
  109    hashtbl_get(Table, Key, Value).
 nb_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 nb_hashtbl_get/3), then shadowed ones.
  117nb_hashtbl_get_all(Table, Key, Value) :-
  118    hashtbl_get_all(Table, Key, Value).
 nb_hashtbl_get_default(!Table, +Key, ?Default, -Value) is det
If Table contains an entry for Key, unifies Value with the corresponding value as in nb_hashtbl_get/3. Otherwise, unifies Value with Default and adds this value to the Table under Key.
  125nb_hashtbl_get_default(Table, Key, Default, Value) :-
  126    hashtbl_load(Table, Load),
  127    hashtbl_bucket(Table, Key, BucketTerm, BucketIdx, Bucket),
  128    (   memberchk(Key-[Value|_], Bucket)
  129    ->  Load1 = Load
  130    ;   Value = Default,
  131        nb_linkarg(BucketIdx, BucketTerm, [Key-[Value]|Bucket]),
  132        Load1 is Load + 1 ),
  133    nb_hashtbl_maybe_resize(Table, Load1).
 nb_hashtbl_delete(!Table, +Key) is det
Deletes the most recent value stored under Key in Table, if any. Does nothing otherwise; succeeds always.
  139nb_hashtbl_delete(Table, Key) :-
  140    hashtbl_load(Table, Load),
  141    hashtbl_bucket(Table, Key, BucketTerm, BucketIdx, Bucket),
  142    (   member(KeyValues, Bucket),
  143        KeyValues = Key-Values
  144    ->  (   Values = [_Old, Next | Rest]
  145        ->  nb_linkarg(2, KeyValues, [Next|Rest]),
  146            Load1 = Load
  147        ;   select(Key-_Values, Bucket, BucketRest)
  148        ->  nb_linkarg(BucketIdx, BucketTerm, BucketRest),
  149            Load1 is Load - 1
  150        ;   assertion(select(Key-_Values, Bucket, _BucketRest)) )
  151    ;   Load1 = Load ),
  152    nb_hashtbl_maybe_resize(Table, Load1).
 nb_hashtbl_maybe_resize(!Table, +Load) is det
Set the Table's stored load to the new value of Load. If the new load is too high, destructively increase the capacity of the hash table (i.e., the number of buckets). All hash table entries are retained. The load is deemed too high if Load / Capacity is greater than 1. The new capacity is Capacity * 2 + 1. This ensures that if the old capacity was of the form 2**N - 1, then the new one is 2**(N+1) - 1.
  162nb_hashtbl_maybe_resize(Table, Load) :-
  163    % First, adjust the table's load.
  164    arg(1, Table, Metadata),
  165    nb_linkarg(1, Metadata, Load),
  166    % Then, check if the load is too high, and resize the table if needed.
  167    hashtbl_buckets(Table, Capacity),
  168    LoadFactor is Load / Capacity,
  169    (   LoadFactor > 1
  170    ->  Capacity1 is Capacity * 2 + 1,
  171        nb_hashtbl_resize(Table, Capacity1)
  172    ;   true ).
 nb_hashtbl_resize(!Table, +Capacity) is det
Table is resized to the given Capacity (number of buckets), retaining all entries.
  178nb_hashtbl_resize(Table, Capacity) :-
  179    empty_nb_hashtbl(Table1, Capacity),
  180    arg(2, Table, BucketTerm),
  181    % Add all Key-Values pairs from Table to Table1.
  182    \+ (
  183        arg(_I, BucketTerm, Bucket),
  184        member(Key-Values, Bucket),
  185        hashtbl_bucket(Table1, Key, BucketTerm1, BucketIdx1, Bucket1),
  186        nb_linkarg(BucketIdx1, BucketTerm1, [Key-Values|Bucket1]),
  187        false
  188    ),
  189    % Replace Table's buckets by Table1's buckets, and we're done.
  190    arg(2, Table1, BucketTerm1),
  191    nb_linkarg(2, Table, BucketTerm1).
 nb_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 nb_hashtbl_get_all/3. The ordering is otherwise unspecified.

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

  202nb_hashtbl_enumerate(Table, Key, Value) :-
  203    hashtbl_enumerate(Table, Key, Value).
 nb_hashtbl_to_list(+Table, -Pairs) is det
Unifies Pairs with a list of all Key-Value pairs in the order as enumerated by nb_hashtbl_enumerate/3.
  209nb_hashtbl_to_list(Table, Pairs) :-
  210    hashtbl_to_list(Table, Pairs).
 list_to_nb_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.
  218list_to_nb_hashtbl(Pairs, Table) :-
  219    hashtbl_default_size(Size),
  220    list_to_nb_hashtbl(Pairs, Table, Size).
 nb_hashtbl_put_pair(!Table, +Pair) is det
If Pair is a Key-Value pair, Value is put into the Table under Key as by nb_hashtbl_put/3.
  226nb_hashtbl_put_pair(Table, Key-Value) :-
  227    nb_hashtbl_put(Table, Key, Value).
 list_to_nb_hashtbl(+Pairs, -Table, +Size) is semidet
As list_to_nb_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.
  235list_to_nb_hashtbl(Pairs, Table, Size) :-
  236    empty_nb_hashtbl(Table, Size),
  237    maplist(nb_hashtbl_put_pair(Table), Pairs).
 nb_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, nb_hashtbl_map/3 enumerates several TableOut tables accordingly.
  245:- meta_predicate nb_hashtbl_map(+, 3, *).  246nb_hashtbl_map(Table, Goal, TableOut) :-
  247    hashtbl_map(Table, Goal, TableOut).
 nb_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.
  256:- meta_predicate nb_hashtbl_fold(+, 4, +, *).  257nb_hashtbl_fold(Table, Goal, Acc, Result) :-
  258    hashtbl_fold(Table, Goal, Acc, Result).
 nb_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.
  265:- meta_predicate nb_hashtbl_iter(+, 2).  266nb_hashtbl_iter(Table, Goal) :-
  267    hashtbl_iter(Table, Goal).
 nb_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.
  275:- meta_predicate nb_hashtbl_unfold(2, -).  276nb_hashtbl_unfold(Goal, Table) :-
  277    empty_nb_hashtbl(Table),
  278    forall(call(Goal, K, V), nb_hashtbl_put(Table, K, V)).
  279
  280
  281:- begin_tests(nb_hashtbl).  282
  283test(put_get_delete, true((One, Two) == (1, 2))) :-
  284    empty_nb_hashtbl(T),
  285    nb_hashtbl_put(T, x, 1),
  286    nb_hashtbl_put(T, x, 2),
  287    nb_hashtbl_get(T, x, Two),
  288    nb_hashtbl_delete(T, x),
  289    nb_hashtbl_get(T, x, One),
  290    nb_hashtbl_delete(T, x),
  291    \+ nb_hashtbl_get(T, x, _).
  292
  293test(put_get_all, all(X == [2, 1])) :-
  294    empty_nb_hashtbl(T),
  295    nb_hashtbl_put(T, x, 1),
  296    nb_hashtbl_put(T, x, 2),
  297    nb_hashtbl_get_all(T, x, X).
  298
  299test(put_get_default, true((X, Y) == (1, default(2)))) :-
  300    empty_nb_hashtbl(T),
  301    nb_hashtbl_put(T, x, 1),
  302    nb_hashtbl_get_default(T, x, default(unused), X),
  303    nb_hashtbl_delete(T, x),
  304    \+ nb_hashtbl_get(T, x, _),
  305    nb_hashtbl_get_default(T, x, default(2), Y).
  306
  307test(put_set_delete, true((A, B, C, D) == (1, 2, 3, 1))) :-
  308    empty_nb_hashtbl(T),
  309    nb_hashtbl_put(T, x, 1),
  310    nb_hashtbl_get(T, x, A),
  311    nb_hashtbl_put(T, x, 2),
  312    nb_hashtbl_get(T, x, B),
  313    nb_hashtbl_set(T, x, 3),
  314    nb_hashtbl_get(T, x, C),
  315    nb_hashtbl_delete(T, x),
  316    nb_hashtbl_get(T, x, D),
  317    nb_hashtbl_delete(T, x),
  318    \+ nb_hashtbl_get(T, x, _),
  319    nb_hashtbl_delete(T, x),
  320    \+ nb_hashtbl_get(T, x, _).
  321
  322test(set_set_delete, true(X == 2)) :-
  323    empty_nb_hashtbl(T),
  324    nb_hashtbl_set(T, x, 1),
  325    nb_hashtbl_set(T, x, 2),
  326    nb_hashtbl_get(T, x, X),
  327    nb_hashtbl_delete(T, x),
  328    \+ nb_hashtbl_get(T, x, _).
  329
  330test(enumerate, set(K-V == [x-1, y-2, z-3])) :-
  331    empty_nb_hashtbl(T),
  332    nb_hashtbl_put(T, x, 1),
  333    nb_hashtbl_put(T, y, 2),
  334    nb_hashtbl_put(T, z, 3),
  335    nb_hashtbl_enumerate(T, K, V).
  336
  337test(to_list, true(Elements == [x-1, y-2, z-3])) :-
  338    empty_nb_hashtbl(T),
  339    nb_hashtbl_put(T, x, 1),
  340    nb_hashtbl_put(T, y, 2),
  341    nb_hashtbl_put(T, z, 3),
  342    nb_hashtbl_to_list(T, List),
  343    sort(List, Elements).
  344
  345test(to_list_order, true(Elements == [x-3, x-2, x-1])) :-
  346    empty_nb_hashtbl(T),
  347    nb_hashtbl_put(T, x, 1),
  348    nb_hashtbl_put(T, x, 2),
  349    nb_hashtbl_put(T, x, 3),
  350    nb_hashtbl_to_list(T, Elements).
  351
  352test(list_to, set(K-V == [x-1, y-2, z-3])) :-
  353    list_to_nb_hashtbl([z-3, y-2, x-1], T),
  354    nb_hashtbl_enumerate(T, K, V).
  355
  356test(map, set(K-V == [x-2, y-3, z-4])) :-
  357    list_to_nb_hashtbl([z-3, y-2, x-1], T),
  358    nb_hashtbl_map(T, utils:test_hashtbl_incr, T1),
  359    nb_hashtbl_enumerate(T1, K, V).
  360
  361test(fold, true(Sum == 6)) :-
  362    list_to_nb_hashtbl([z-3, y-2, x-1], T),
  363    nb_hashtbl_fold(T, utils:test_hashtbl_sum, 0, Sum).
  364
  365test(fold_noncommutative,
  366     true(List == cons(x-1, cons(x-2, cons(x-3, nil))))) :-
  367    list_to_nb_hashtbl([x-1, x-2, x-3], T),
  368    nb_hashtbl_fold(T, utils:test_hashtbl_cons, nil, List).
  369
  370test(iter, true(Sum == sum(6))) :-
  371    list_to_nb_hashtbl([z-3, y-2, x-1], T),
  372    Sum = sum(0),
  373    nb_hashtbl_iter(T, utils:test_hashtbl_nb_sum(Sum)).
  374
  375test(unfold, true(Unfold = nb_hashtbl_unfold(_Goal, _Table))) :-
  376    nb_hashtbl_unfold(current_predicate, T),
  377    nb_hashtbl_get(T, nb_hashtbl_unfold, Unfold).
  378
  379test(unfold_order, all(Values == [b, a])) :-
  380    nb_hashtbl_unfold(utils:test_k_ab_table, T),
  381    nb_hashtbl_get_all(T, k, Values).
  382
  383test(unfold_empty, true(Elements == [])) :-
  384    nb_hashtbl_unfold(utils:always_false, T),
  385    nb_hashtbl_to_list(T, Elements).
  386
  387test(backtracking, [true(Elements == [a-b, c-d, e-f])]) :-
  388    empty_nb_hashtbl(T),
  389    (   nb_hashtbl_put(T, a, b),
  390        false
  391    ;   nb_hashtbl_put(T, c, d),
  392        false
  393    ;   nb_hashtbl_put(T, e, f) ),
  394    nb_hashtbl_to_list(T, List),
  395    sort(List, Elements).
  396
  397test(destructive_no_backtrack, [
  398     setup(\+ nb_current(nb_hashtbl_test_var, _)),
  399     cleanup(nb_delete(nb_hashtbl_test_var)),
  400     true(B-D == b-d)]) :-
  401    empty_nb_hashtbl(T),
  402    nb_linkval(nb_hashtbl_test_var, T),
  403    nb_hashtbl_put(T, a, b),
  404    nb_hashtbl_put(T, c, d),
  405    nb_getval(nb_hashtbl_test_var, T2),
  406    nb_hashtbl_get(T2, a, B),
  407    nb_hashtbl_get(T2, c, D).
  408
  409test(destructive_backtrack, [
  410     setup(\+ nb_current(nb_hashtbl_test_var, _)),
  411     cleanup(nb_delete(nb_hashtbl_test_var)),
  412     true(B-D == b-d)]) :-
  413    (   empty_nb_hashtbl(T),
  414        nb_linkval(nb_hashtbl_test_var, T),
  415        nb_hashtbl_put(T, a, b),
  416        nb_hashtbl_put(T, c, d),
  417        false
  418    ;   nb_getval(nb_hashtbl_test_var, T2),
  419        nb_hashtbl_get(T2, a, B),
  420        nb_hashtbl_get(T2, c, D) ).
  421
  422test(no_resize, [FinalBuckets == 1]) :-
  423    empty_nb_hashtbl(T, 1),
  424    nb_hashtbl_put(T, x, 1),
  425    nb_hashtbl_put(T, x, 2),
  426    nb_hashtbl_set(T, x, 3),
  427    hashtbl_buckets(T, FinalBuckets).
  428
  429test(resize, [FinalBuckets == 3]) :-
  430    empty_nb_hashtbl(T, 1),
  431    nb_hashtbl_put(T, x, 1),
  432    nb_hashtbl_put(T, y, 2),
  433    hashtbl_buckets(T, FinalBuckets).
  434
  435:- end_tests(nb_hashtbl).