[m-rev.] for review: chaining hash tables
Peter Wang
novalazy at gmail.com
Wed Mar 25 17:24:35 AEDT 2009
Branches: main
Replace the implementations of (version) hash tables by separate chaining hash
tables. The old open addressing scheme was broken in the presence of deletes.
Fixes bug #68.
library/hash_table.m:
library/version_hash_table.m:
As above.
We no longer use double hashing in case of a hash collision, so hash
predicates only need to return one value now.
Add fold with predicate arguments.
library/array.m:
Add array.foldl for a predicate argument.
Add array.foldl2 with a unique state pair.
library/version_array.m:
Add version_array.foldl for a predicate argument.
compiler/make.m:
compiler/make.program_target.m:
compiler/make.util.m:
library/robdd.m:
Conform to change in hashing predicates.
deep_profiler/dense_bitset.m:
Add module qualifier to avoid ambiguity.
tests/hard_coded/Mmakefile:
tests/hard_coded/hash_table_delete.exp:
tests/hard_coded/hash_table_delete.m:
tests/hard_coded/hash_table_test.exp:
tests/hard_coded/hash_table_test.m:
tests/hard_coded/version_hash_table_delete.exp:
tests/hard_coded/version_hash_table_delete.m:
tests/hard_coded/version_hash_table_test2.exp:
tests/hard_coded/version_hash_table_test2.m:
Add new test cases.
tests/hard_coded/hash_bug.m:
tests/hard_coded/hash_init_bug.m:
tests/hard_coded/version_hash_table_test.m:
Conform to change in hashing predicates.
NEWS:
Document additions.
diff --git a/NEWS b/NEWS
index b51b631..4ea8a58 100644
--- a/NEWS
+++ b/NEWS
@@ -95,8 +95,10 @@ Changes to the Mercury standard library:
* The following predicate has been added to the set module:
set.filter_map/3
-* The following predicate has been added to the array module:
+* The following predicates have been added to the array modules:
+ array.fold/4
array.foldl2/6
+ version_array.foldl/4
* The following predicates have been added to the list module:
list.filter_map_foldl/5
@@ -255,6 +257,10 @@ Changes to the Mercury standard library:
map.from_sorted_assoc_list now also constructs the tree directly, so now
it requires its input list to be duplicate-free.
+* We have replaced the hash_table and version_hash_table implementations
+ with separate chaining schemes. Consequently delete works, and double
+ hashing predicates are not required.
+
* We have added a calendar module to the standard library. This module
contains utilities for working with the Gregorian calendar.
diff --git a/compiler/make.m b/compiler/make.m
index 895b935..f017019 100644
--- a/compiler/make.m
+++ b/compiler/make.m
@@ -322,13 +322,12 @@ make_process_args(Variables, OptionArgs, Targets0, !IO) :-
globals.io_get_globals(Globals, !IO),
ModuleIndexMap = module_index_map(
- version_hash_table.new_default(module_name_double_hash),
+ version_hash_table.new_default(module_name_hash),
version_array.empty, 0),
DepIndexMap = dependency_file_index_map(
- version_hash_table.new_default(dependency_file_double_hash),
+ version_hash_table.new_default(dependency_file_hash),
version_array.empty, 0),
- DepStatusMap = version_hash_table.new_default(
- dependency_file_double_hash),
+ DepStatusMap = version_hash_table.new_default(dependency_file_hash),
%
% Accept and ignore `.depend' targets. `mmc --make' does not
diff --git a/compiler/make.program_target.m b/compiler/make.program_target.m
index 3dbb7b6..8fac5cd 100644
--- a/compiler/make.program_target.m
+++ b/compiler/make.program_target.m
@@ -1267,8 +1267,7 @@ install_library_grade(LinkSucceeded0,
ModuleName, AllModules, Grade, Succeeded,
% StatusMap0 = Info0 ^ dependency_status,
% StatusMap = version_hash_table.fold(remove_grade_dependent_targets,
% StatusMap0, StatusMap0),
- StatusMap = version_hash_table.new_default(
- dependency_file_double_hash),
+ StatusMap = version_hash_table.new_default(dependency_file_hash),
Info1 = (Info0 ^ dependency_status := StatusMap)
^ option_args := OptionArgs,
diff --git a/compiler/make.util.m b/compiler/make.util.m
index 25e0426..2f38aa6 100644
--- a/compiler/make.util.m
+++ b/compiler/make.util.m
@@ -307,11 +307,9 @@
% Hash functions
%
-:- pred module_name_double_hash(module_name::in, int::out, int::out)
- is det.
+:- pred module_name_hash(module_name::in, int::out) is det.
-:- pred dependency_file_double_hash(dependency_file::in, int::out, int::out)
- is det.
+:- pred dependency_file_hash(dependency_file::in, int::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -1607,40 +1605,33 @@ make_write_module_or_linked_target(ModuleName
- FileType, !IO) :-
% Hash functions
%
-module_name_double_hash(ModuleName, HashA, HashB) :-
- HashA = module_name_hash(ModuleName),
- HashB = concoct_second_hash(HashA).
+module_name_hash(SymName, Hash) :-
+ (
+ SymName = unqualified(String),
+ Hash = string.hash(String)
+ ;
+ SymName = qualified(_Qual, String),
+ % Hashing the the module qualifier seems to be not worthwhile.
+ Hash = string.hash(String)
+ ).
-dependency_file_double_hash(DepFile, HashA, HashB) :-
+dependency_file_hash(DepFile, Hash) :-
(
DepFile = dep_target(TargetFile),
- HashA = target_file_hash(TargetFile) `mix` 123
+ Hash = target_file_hash(TargetFile)
;
DepFile = dep_file(FileName, _MaybeOption),
- HashA = string.hash(FileName) `mix` 456
- ),
- HashB = concoct_second_hash(HashA).
+ Hash = string.hash(FileName)
+ ).
:- func target_file_hash(target_file) = int.
target_file_hash(TargetFile) = Hash :-
TargetFile = target_file(ModuleName, Type),
- Hash0 = module_name_hash(ModuleName),
+ module_name_hash(ModuleName, Hash0),
Hash1 = module_target_type_to_nonce(Type),
Hash = mix(Hash0, Hash1).
-:- func module_name_hash(module_name) = int.
-
-module_name_hash(SymName) = Hash :-
- (
- SymName = unqualified(String),
- Hash = string.hash(String)
- ;
- SymName = qualified(_Qual, String),
- % Hashing the the module qualifier seems to be not worthwhile.
- Hash = string.hash(String)
- ).
-
:- func module_target_type_to_nonce(module_target_type) = int.
module_target_type_to_nonce(Type) = X :-
diff --git a/deep_profiler/dense_bitset.m b/deep_profiler/dense_bitset.m
index b30db29..771b9ed 100644
--- a/deep_profiler/dense_bitset.m
+++ b/deep_profiler/dense_bitset.m
@@ -103,7 +103,7 @@ delete(A0, I) = A :-
).
union(A, B) = C :-
- foldl((pred(I::in, C0::array_di, C1::array_uo) is det :-
+ dense_bitset.foldl((pred(I::in, C0::in, C1::out) is det :-
C1 = insert(C0, I)
), A, B, C).
diff --git a/library/array.m b/library/array.m
index fc89794..e7d33a4 100644
--- a/library/array.m
+++ b/library/array.m
@@ -376,9 +376,23 @@
%:- mode array.foldl(func(in, di) = uo is det, array_ui, di) = uo is det.
:- mode array.foldl(func(in, di) = uo is det, in, di) = uo is det.
+ % array.foldl(Pr, Array, !X) is equivalent to
+ % list.foldl(Pr, array.to_list(Array), !X)
+ % but more efficient.
+ %
+:- pred array.foldl(pred(T1, T2, T2), array(T1), T2, T2).
+:- mode array.foldl(pred(in, in, out) is det, in, in, out) is det.
+:- mode array.foldl(pred(in, di, uo) is det, in, di, uo) is det.
+
+ % array.foldl2(Pr, Array, !X, !Y) is equivalent to
+ % list.foldl2(Pr, array.to_list(Array), !X, !Y)
+ % but more efficient.
+ %
:- pred array.foldl2(pred(T1, T2, T2, T3, T3), array(T1), T2, T2, T3, T3).
:- mode array.foldl2(pred(in, in, out, in, out) is det, in, in, out, in, out)
is det.
+:- mode array.foldl2(pred(in, in, out, di, uo) is det, in, in, out, di, uo)
+ is det.
% array.foldr(Fn, Array, X) is equivalent to
% list.foldr(Fn, array.to_list(Array), X)
@@ -1476,6 +1490,23 @@ foldl_0(Fn, A, X, I, Max) =
% ----------------------------------------------------------------------------
%
+array.foldl(P, A, !X) :-
+ array.foldl_0(P, A, array.min(A), array.max(A), !X).
+
+:- pred foldl_0(pred(T1, T2, T2), array(T1), int, int, T2, T2).
+:- mode foldl_0(pred(in, in, out) is det, in, in, in, in, out) is det.
+:- mode foldl_0(pred(in, di, uo) is det, in, in, in, di, uo) is det.
+
+foldl_0(P, A, I, Max, !X) :-
+ ( Max < I ->
+ true
+ ;
+ P(A ^ elem(I), !X),
+ foldl_0(P, A, I+1, Max, !X)
+ ).
+
+% ----------------------------------------------------------------------------
%
+
array.foldl2(P, A, X0, X, Y0, Y) :-
array.foldl2_0(P, A, array.min(A), array.max(A), X0, X, Y0, Y).
@@ -1483,6 +1514,8 @@ array.foldl2(P, A, X0, X, Y0, Y) :-
T3, T3).
:- mode foldl2_0(pred(in, in, out, in, out) is det, in, in, in, in, out,
in, out) is det.
+:- mode foldl2_0(pred(in, in, out, di, uo) is det, in, in, in, in, out,
+ di, uo) is det.
foldl2_0(P, A, I, Max, X0, X, Y0, Y) :-
( Max < I ->
diff --git a/library/hash_table.m b/library/hash_table.m
index 7ecfa90..7989291 100644
--- a/library/hash_table.m
+++ b/library/hash_table.m
@@ -7,17 +7,16 @@
%-----------------------------------------------------------------------------%
%
% File: hash_table.m.
-% Main author: rafe.
+% Main author: rafe, wangp.
% Stability: low.
%
% Hash table implementation.
%
-% This implementation uses double hashing and requires the user to
-% supply a predicate that will compute two independent hash values
-% for any given key.
+% This implementation requires the user to supply a predicate that
+% will compute a hash value for any given key.
%
-% Default double-hash functions are provided for ints, strings and
-% generic values.
+% Default hash functions are provided for ints, strings and generic
+% values.
%
% The number of buckets in the hash table is always a power of 2.
%
@@ -41,7 +40,6 @@
:- import_module array.
:- import_module assoc_list.
-:- import_module bitmap.
:- import_module char.
%-----------------------------------------------------------------------------%
@@ -50,25 +48,21 @@
% XXX This is all fake until the compiler can handle nested unique modes.
%
-:- inst hash_table ==
- bound(ht(ground, ground, ground, hash_pred, bitmap, array, array)).
+:- inst hash_table == bound(ht(ground, ground, hash_pred, array)).
:- mode hash_table_ui == in(hash_table).
:- mode hash_table_di == di(hash_table).
:- mode hash_table_uo == out(hash_table).
-:- type hash_pred(K) == ( pred(K, int, int) ).
-:- inst hash_pred == ( pred(in, out, out) is det ).
+:- type hash_pred(K) == ( pred(K, int) ).
+:- inst hash_pred == ( pred(in, out) is det ).
% new(HashPred, N, MaxOccupancy)
% constructs a new hash table with initial size 2 ^ N that is
% doubled whenever MaxOccupancy is achieved; elements are
% indexed using HashPred.
%
- % HashPred must compute two *independent* hashes for a given
- % key - that is, one hash should not be a function of the other.
- % Otherwise poor performance will result.
- %
- % N must be greater than 1.
+ % HashPred must compute a hash for a given key.
+ % N must be greater than 0.
% MaxOccupancy must be in (0.0, 1.0).
%
% XXX Values too close to the limits may cause bad things
@@ -90,16 +84,11 @@
% Default hash_preds for ints and strings and everything (buwahahaha!)
%
-:- pred int_double_hash(int::in, int::out, int::out) is det.
-
-:- pred string_double_hash(string::in, int::out, int::out) is det.
-
-:- pred char_double_hash(char::in, int::out, int::out) is det.
-
-:- pred float_double_hash(float::in, int::out, int::out) is det.
-
-:- pred generic_double_hash(T, int, int).
-:- mode generic_double_hash(in, out, out) is det.
+:- pred int_hash(int::in, int::out) is det.
+:- pred string_hash(string::in, int::out) is det.
+:- pred char_hash(char::in, int::out) is det.
+:- pred float_hash(float::in, int::out) is det.
+:- pred generic_hash(T::in, int::out) is det.
% Returns the number of buckets in a hash table.
%
@@ -115,6 +104,7 @@
% Insert key-value binding into a hash table; if one is
% already there then the previous value is overwritten.
+ % A predicate version is also provided.
%
:- func set(hash_table(K, V), K, V) = hash_table(K, V).
:- mode set(hash_table_di, in, in) = hash_table_uo is det.
@@ -128,8 +118,9 @@
:- func 'elem :='(K, hash_table(K, V), V) = hash_table(K, V).
:- mode 'elem :='(in, hash_table_di, in) = hash_table_uo is det.
- % Insert a key-value binding into a hash table. An exception is thrown
- % if a binding for the key is already present.
+ % Insert a key-value binding into a hash table. An
+ % exception is thrown if a binding for the key is already
+ % present. A predicate version is also provided.
%
:- func det_insert(hash_table(K, V), K, V) = hash_table(K, V).
:- mode det_insert(hash_table_di, in, in) = hash_table_uo is det.
@@ -137,8 +128,9 @@
:- pred det_insert(K::in, V::in,
hash_table(K, V)::hash_table_di, hash_table(K, V)::hash_table_uo) is det.
- % Change a key-value binding in a hash table. An exception is thrown
- % if a binding for the key does not already exist.
+ % Change a key-value binding in a hash table. An
+ % exception is thrown if a binding for the key does not
+ % already exist. A predicate version is also provided.
%
:- func det_update(hash_table(K, V), K, V) = hash_table(K, V).
:- mode det_update(hash_table_di, in, in) = hash_table_uo is det.
@@ -147,7 +139,8 @@
hash_table(K, V)::hash_table_di, hash_table(K, V)::hash_table_uo) is det.
% Delete the entry for the given key, leaving the hash table
- % unchanged if there is no such entry.
+ % unchanged if there is no such entry. A predicate version is also
+ % provided.
%
:- func delete(hash_table(K, V), K) = hash_table(K, V).
:- mode delete(hash_table_di, in) = hash_table_uo is det.
@@ -155,8 +148,8 @@
:- pred delete(K::in,
hash_table(K, V)::hash_table_di, hash_table(K, V)::hash_table_uo) is det.
- % Lookup the value associated with the given key. An exception is raised
- % if there is no entry for the key.
+ % Lookup the value associated with the given key. An exception
+ % is raised if there is no entry for the key.
%
:- func lookup(hash_table(K, V), K) = V.
:- mode lookup(hash_table_ui, in) = out is det.
@@ -196,6 +189,12 @@
:- mode fold(func(in, in, in) = out is det, hash_table_ui, in) = out is det.
:- mode fold(func(in, in, di) = uo is det, hash_table_ui, di) = uo is det.
+ % Fold a predicate over the key-value bindings in a hash table.
+ %
+:- pred fold(pred(K, V, T, T), hash_table(K, V), T, T).
+:- mode fold(in(pred(in, in, in, out) is det), hash_table_ui, in, out) is det.
+:- mode fold(in(pred(in, in, di, uo) is det), hash_table_ui, di, uo) is det.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -208,7 +207,6 @@
:- import_module int.
:- import_module list.
:- import_module pair.
-:- import_module require.
:- import_module string.
:- import_module type_desc.
:- import_module univ.
@@ -218,68 +216,34 @@
:- interface.
% This should be abstract, but needs to be exported for insts.
+ % We should consider using a mutable for num_occupants.
%
:- type hash_table(K, V)
---> ht(
- num_buckets :: int,
num_occupants :: int,
max_occupants :: int,
hash_pred :: hash_pred(K),
- bitmap :: bitmap,
- keys :: array(K),
- values :: array(V)
+ buckets :: array(assoc_list(K, V))
).
:- implementation.
%-----------------------------------------------------------------------------%
- % THE HASHING SCHEME
- %
- % The user provided hashing function computes two independent
- % hashes H1 and H2 for a given key K.
- %
- % We calculate D = 2*H2 + 1 (to ensure that D is non-zero and
- % odd and is therefore coprime to the number of buckets) and
- % probe the table where the Kth probe examines slot
- %
- % (H1 + K * H2) `mod` num_buckets
- %
- % The search is guaranteed to terminate because table occupancy
- % must be less than 1.0.
- %
- % The bitmap keeps track of which slots are occupied.
- %
- % If a slot is occupied, then the corresponding element in
- % the keys array is used to decide whether this probe has
- % found the right slot.
- %
- % Once the right slot has been found, the value can be found
- % in the corresponding element in the values array.
- %
- % The keys and values arrays cannot be initialised until at
- % least one binding is inserted. This is handled by checking
- % to see whether the keys array has non-zero size.
-
-%-----------------------------------------------------------------------------%
-
new(HashPred, N, MaxOccupancy) = HT :-
- ( if N =< 1 then
- throw(software_error("hash_table.new_hash_table: N =< 1"))
+ ( if N =< 0 then
+ throw(software_error("hash_table.new: N =< 0"))
else if N >= int.bits_per_int then
throw(software_error(
- "hash_table.new_hash_table: N >= int.bits_per_int"))
- else if MaxOccupancy =< 0.0 ; 1.0 =< MaxOccupancy then
+ "hash_table.new: N >= int.bits_per_int"))
+ else if MaxOccupancy =< 0.0 then
throw(software_error(
- "hash_table.new_hash_table: MaxOccupancy not in (0.0, 1.0)"))
+ "hash_table.new: MaxOccupancy =< 0.0"))
else
NumBuckets = 1 << N,
MaxOccupants = ceiling_to_int(float(NumBuckets) * MaxOccupancy),
- Bitmap = bitmap.new(NumBuckets, no),
- Keys = array.make_empty_array,
- Values = array.make_empty_array,
- HT = ht(NumBuckets, 0, MaxOccupants, HashPred, Bitmap,
- Keys, Values)
+ Buckets = init(NumBuckets, []),
+ HT = ht(0, MaxOccupants, HashPred, Buckets)
).
%-----------------------------------------------------------------------------%
@@ -290,77 +254,48 @@ new_default(HashPred) = new(HashPred, 7, 0.9).
%-----------------------------------------------------------------------------%
- % find_slot(HT, K) looks up key K in hash table HT and
- % returns the index for the entry K in H. This is either the
- % first free slot identified (K is not in the table, but here
- % is where it would go) or the slot for K (K is in the table
- % and this is its slot).
- %
- % Whether or not K is actually in the table can be decided
- % by checking to see whether its bit in the bitmap is set
- % or clear.
- %
+num_buckets(HT) = size(HT ^ buckets).
+
+%-----------------------------------------------------------------------------%
+
:- func find_slot(hash_table(K, V), K) = int.
:- mode find_slot(hash_table_ui, in) = out is det.
%:- mode find_slot(in, in) = out is det.
find_slot(HT, K) = H :-
- (HT ^ hash_pred)(K, Hash1, Hash2),
- H0 = Hash1 mod HT ^ num_buckets,
- % Have to ensure it's odd and non-zero.
- Delta = Hash2 + Hash2 + 1,
- H = find_slot_2(HT, K, H0, Delta).
-
-:- func find_slot_2(hash_table(K, V), K, int, int) = int.
-:- mode find_slot_2(hash_table_ui, in, in, in) = out is det.
-%:- mode find_slot_2(in, in, in, in) = out is det.
-
-find_slot_2(HT, K, H0, Delta) = H :-
- ( if bitmap.is_clear(HT ^ bitmap, H0) then
- H = H0
- else if HT ^ keys ^ elem(H0) = K then
- H = H0
- else
- H1 = (H0 + Delta) mod HT ^ num_buckets,
- H = find_slot_2(HT, K, H1, Delta)
- ).
+ find_slot_2(HT ^ hash_pred, K, HT ^ num_buckets, H).
-%-----------------------------------------------------------------------------%
+:- pred find_slot_2(hash_pred(K)::in(hash_pred), K::in, int::in, int::out)
+ is det.
-set(HT0, K, V) = HT :-
+find_slot_2(HashPred, K, NumBuckets, H) :-
+ HashPred(K, Hash),
+ % Since NumBuckets is a power of two we can avoid mod.
+ H = Hash /\ (NumBuckets - 1).
- % If this is the first entry in the hash table, then we use it to
- % set up the hash table (the arrays are currently empty because we
- % need values to initialise them with).
- %
- ( if array.size(HT0 ^ values) = 0 then
- HT = set(
- (( HT0
- ^ keys := array.init(HT0 ^ num_buckets, K) )
- ^ values := array.init(HT0 ^ num_buckets, V) ),
- K, V
- )
+%-----------------------------------------------------------------------------%
+
+set(!.HT, K, V) = !:HT :-
+ H = find_slot(!.HT, K),
+ AL0 = !.HT ^ buckets ^ elem(H),
+ ( if assoc_list.remove(AL0, K, _, AL1) then
+ AL = [K - V | AL1],
+ MayExpand = no
else
- H = find_slot(HT0, K),
- ( if bitmap.is_set(HT0 ^ bitmap, H) then
- HT = ( HT0 ^ values ^ elem(H) := V )
- else
- HT =
- ( if HT0 ^ num_occupants = HT0 ^ max_occupants then
- set(expand(HT0), K, V)
- else
- (((( HT0
- ^ num_occupants := HT0 ^ num_occupants + 1 )
- ^ bitmap := bitmap.set(HT0 ^ bitmap, H))
- ^ keys ^ elem(H) := K )
- ^ values ^ elem(H) := V )
- )
- )
+ AL = [K - V | AL0],
+ MayExpand = yes
+ ),
+ !HT ^ buckets ^ elem(H) := AL,
+ (
+ MayExpand = no
+ ;
+ MayExpand = yes,
+ increase_occupants(!HT)
).
'elem :='(K, HT, V) = set(HT, K, V).
-set(K, V, HT, HT ^ elem(K) := V).
+set(K, V, HT, set(HT, K, V)).
%-----------------------------------------------------------------------------%
@@ -368,31 +303,21 @@ search(HT, K, search(HT, K)).
search(HT, K) = V :-
H = find_slot(HT, K),
- bitmap.is_set(HT ^ bitmap, H),
- V = HT ^ values ^ elem(H).
+ AL = HT ^ buckets ^ elem(H),
+ assoc_list.search(AL, K, V).
%-----------------------------------------------------------------------------%
-det_insert(HT0, K, V) = HT :-
- H = find_slot(HT0, K),
- ( if bitmap.is_set(HT0 ^ bitmap, H) then
+det_insert(!.HT, K, V) = !:HT :-
+ H = find_slot(!.HT, K),
+ AL0 = !.HT ^ buckets ^ elem(H),
+ ( if assoc_list.search(AL0, K, _) then
throw(software_error("hash_table.det_insert: key already present"))
- else if HT0 ^ num_occupants = HT0 ^ max_occupants then
- HT = set(expand(HT0), K, V)
- else if array.size(HT0 ^ values) = 0 then
- % If this is the first entry in the hash table, then we use it to
- % set up the hash table (the arrays are currently empty because we
- % need values to initialise them with).
- %
- HT = set(HT0, K, V)
else
- HT = (((( HT0
- ^ num_occupants := HT0 ^ num_occupants + 1 )
- ^ bitmap := bitmap.set(HT0 ^ bitmap, H) )
- ^ keys ^ elem(H) := K )
- ^ values ^ elem(H) := V )
- ).
-
+ AL = [K - V | AL0]
+ ),
+ !HT ^ buckets ^ elem(H) := AL,
+ increase_occupants(!HT).
det_insert(K, V, HT, det_insert(HT, K, V)).
@@ -400,12 +325,13 @@ det_insert(K, V, HT, det_insert(HT, K, V)).
det_update(HT0, K, V) = HT :-
H = find_slot(HT0, K),
- ( if bitmap.is_clear(HT0 ^ bitmap, H) then
- throw(software_error("hash_table.det_update: key not found"))
+ AL0 = HT0 ^ buckets ^ elem(H),
+ ( if assoc_list.remove(AL0, K, _, AL1) then
+ AL = [K - V | AL1]
else
- HT = HT0 ^ values ^ elem(H) := V
- ).
-
+ throw(software_error("hash_table.det_update: key not found"))
+ ),
+ HT = HT0 ^ buckets ^ elem(H) := AL.
det_update(K, V, HT, det_update(HT, K, V)).
@@ -421,29 +347,24 @@ elem(K, HT) = lookup(HT, K).
%-----------------------------------------------------------------------------%
-delete(HT, K) =
- HT ^ bitmap := bitmap.clear(HT ^ bitmap, find_slot(HT, K)).
-
+delete(HT0, K) = HT :-
+ H = find_slot(HT0, K),
+ AL0 = HT0 ^ buckets ^ elem(H),
+ ( if assoc_list.remove(AL0, K, _, AL) then
+ HT0 = ht(NumOccupants0, MaxOccupants, HashPred, Buckets0),
+ Buckets = Buckets0 ^ elem(H) := AL,
+ NumOccupants = NumOccupants0 - 1,
+ HT = ht(NumOccupants, MaxOccupants, HashPred, Buckets)
+ else
+ HT = HT0
+ ).
delete(K, HT, delete(HT, K)).
%-----------------------------------------------------------------------------%
-to_assoc_list(HT) = to_assoc_list_2(0, HT, []).
-
-:- func to_assoc_list_2(int,hash_table(K,V),assoc_list(K,V)) = assoc_list(K,V).
-:- mode to_assoc_list_2(in, hash_table_ui, in) = out is det.
-%:- mode to_assoc_list_2(in, in, in) = out is det.
-
-to_assoc_list_2(I, HT, AList) =
- ( if I >= HT ^ num_buckets then
- AList
- else if bitmap.is_clear(HT ^ bitmap, I) then
- to_assoc_list_2(I + 1, HT, AList)
- else
- to_assoc_list_2(I + 1, HT,
- [(HT ^ keys ^ elem(I)) - (HT ^ values ^ elem(I)) | AList])
- ).
+to_assoc_list(HT) =
+ foldl(list.append, HT ^ buckets, []).
from_assoc_list(HP, AList) = from_assoc_list_2(AList, new_default(HP)).
@@ -459,174 +380,212 @@ from_assoc_list_2([K - V | AList], HT) =
%-----------------------------------------------------------------------------%
- % Hash tables expand by doubling in size.
- %
-:- func expand(hash_table(K, V)) = hash_table(K, V).
-:- mode expand(hash_table_di) = hash_table_uo is det.
+:- pred increase_occupants(hash_table(K, V), hash_table(K, V)).
+:- mode increase_occupants(hash_table_di, hash_table_uo) is det.
-expand(HT0) = HT :-
+increase_occupants(!HT) :-
+ NumOccupants = !.HT ^ num_occupants,
+ MaxOccupants = !.HT ^ max_occupants,
+ ( if NumOccupants = MaxOccupants then
+ expand(!HT)
+ else
+ !HT ^ num_occupants := NumOccupants + 1
+ ).
- HT0 = ht(NBs0, _NOs, MOs0, HP, BM0, Ks0, Vs0),
+ % Hash tables expand by doubling in size.
+ %
+:- pred expand(hash_table(K, V), hash_table(K, V)).
+:- mode expand(hash_table_di, hash_table_uo) is det.
- NBs = NBs0 + NBs0,
- MOs = MOs0 + MOs0,
- BM = bitmap.new(NBs, no),
- Ks = array.make_empty_array,
- Vs = array.make_empty_array,
+expand(HT0, HT) :-
+ HT0 = ht(NumOccupants0, MaxOccupants0, HashPred, Buckets0),
- HT1 = ht(NBs, 0, MOs, HP, BM, Ks, Vs),
+ NumBuckets0 = size(Buckets0),
+ NumBuckets = NumBuckets0 + NumBuckets0,
+ MaxOccupants = MaxOccupants0 + MaxOccupants0,
- HT = reinsert_bindings(0, NBs0, BM0, Ks0, Vs0, HT1).
+ Buckets1 = init(NumBuckets, []),
+ reinsert_bindings(0, Buckets0, HashPred, NumBuckets, Buckets1, Buckets),
-%-----------------------------------------------------------------------------%
+ HT = ht(NumOccupants0 + 1, MaxOccupants, HashPred, Buckets).
-:- func reinsert_bindings(int, int, bitmap, array(K), array(V),
- hash_table(K, V)) = hash_table(K, V).
-:- mode reinsert_bindings(in, in, bitmap_ui, array_ui, array_ui,
- hash_table_di) = hash_table_uo is det.
+:- pred reinsert_bindings(int, array(assoc_list(K, V)), hash_pred(K),
+ int, array(assoc_list(K, V)), array(assoc_list(K,V))).
+:- mode reinsert_bindings(in, array_ui, in(hash_pred),
+ in, array_di, array_uo) is det.
-reinsert_bindings(I, NumBuckets, Bitmap, Keys, Values, HT) =
- ( if I >= NumBuckets then
- HT
- else if bitmap.is_clear(Bitmap, I) then
- reinsert_bindings(I + 1, NumBuckets, Bitmap, Keys, Values, HT)
+reinsert_bindings(I, OldBuckets, HashPred, NumBuckets, !Buckets) :-
+ ( if I >= size(OldBuckets) then
+ true
else
- reinsert_bindings(I + 1, NumBuckets, Bitmap, Keys, Values,
- set(HT, Keys ^ elem(I), Values ^ elem(I)))
+ AL = OldBuckets ^ elem(I),
+ reinsert_assoc_list(AL, HashPred, NumBuckets, !Buckets),
+ reinsert_bindings(I + 1, OldBuckets, HashPred, NumBuckets, !Buckets)
).
+:- pred reinsert_assoc_list(assoc_list(K, V), hash_pred(K),
+ int, array(assoc_list(K, V)), array(assoc_list(K, V))).
+:- mode reinsert_assoc_list(in, in(hash_pred),
+ in, array_di, array_uo) is det.
+
+reinsert_assoc_list([], _, _, !Buckets).
+reinsert_assoc_list([KV | KVs], HashPred, NumBuckets, !Buckets) :-
+ unsafe_insert(KV, HashPred, NumBuckets, !Buckets),
+ reinsert_assoc_list(KVs, HashPred, NumBuckets, !Buckets).
+
+:- pred unsafe_insert(pair(K, V), hash_pred(K),
+ int, array(assoc_list(K, V)), array(assoc_list(K, V))).
+:- mode unsafe_insert(in, in(hash_pred),
+ in, array_di, array_uo) is det.
+
+unsafe_insert(KV, HashPred, NumBuckets, Buckets0, Buckets) :-
+ KV = K - _,
+ find_slot_2(HashPred, K, NumBuckets, H),
+ AL0 = Buckets0 ^ elem(H),
+ Buckets = Buckets0 ^ elem(H) := [KV | AL0].
+
%-----------------------------------------------------------------------------%
% There are almost certainly better ones out there...
%
- % NOTE that H1 \= N since neither of H1 or H2 should be a function
- % of the other under machine integer arithmetic.
+int_hash(N, N).
+
+ % From http://www.concentric.net/~Ttwang/tech/inthash.htm
+ % public int hash32shift(int key)
+ % public long hash64shift(long key)
%
-int_double_hash(N, H1, H2) :-
- H1 = N * N,
- H2 = N `xor` (N + N).
+:- pragma foreign_proc("C",
+ int_hash(N::in, H::out),
+ [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
+"
+ const int c2 = 0x27d4eb2d; /* a prime or an odd constant */
+ MR_Unsigned key;
+
+ key = N;
+
+ if (sizeof(MR_Word) == 4) {
+ key = (key ^ 61) ^ (key >> 16);
+ key = key + (key << 3);
+ key = key ^ (key >> 4);
+ key = key * c2;
+ key = key ^ (key >> 15);
+ } else {
+ key = (~key) + (key << 21); /* key = (key << 21) - key - 1; */
+ key = key ^ (key >> 24);
+ key = (key + (key << 3)) + (key << 8); /* key * 265 */
+ key = key ^ (key >> 14);
+ key = (key + (key << 2)) + (key << 4); /* key * 21 */
+ key = key ^ (key >> 28);
+ key = key + (key << 31);
+ }
+
+ H = key;
+").
%-----------------------------------------------------------------------------%
% There are almost certainly better ones out there...
%
-string_double_hash(S, H1, H2) :-
- H1 = string.hash(S),
- H2 = string.foldl(func(C, N) = char.to_int(C) + N, S, 0).
+string_hash(S, string.hash(S)).
%-----------------------------------------------------------------------------%
% There are almost certainly better ones out there...
%
-float_double_hash(F, H1, H2) :-
- H1 = float.hash(F),
- H2 = float.hash(F * F).
+float_hash(F, float.hash(F)).
%-----------------------------------------------------------------------------%
% There are almost certainly better ones out there...
%
-char_double_hash(C, H1, H2) :-
- int_double_hash(char.to_int(C), H1, H2).
+char_hash(C, H) :-
+ int_hash(char.to_int(C), H).
%-----------------------------------------------------------------------------%
% This, again, is straight off the top of my head.
%
-generic_double_hash(T, Ha, Hb) :-
+generic_hash(T, H) :-
( if dynamic_cast(T, Int) then
- int_double_hash(Int, Ha, Hb)
+ int_hash(Int, H)
else if dynamic_cast(T, String) then
- string_double_hash(String, Ha, Hb)
+ string_hash(String, H)
else if dynamic_cast(T, Float) then
- float_double_hash(Float, Ha, Hb)
+ float_hash(Float, H)
else if dynamic_cast(T, Char) then
- char_double_hash(Char, Ha, Hb)
+ char_hash(Char, H)
else if dynamic_cast(T, Univ) then
- generic_double_hash(univ_value(Univ), Ha, Hb)
+ generic_hash(univ_value(Univ), H)
else if dynamic_cast_to_array(T, Array) then
- {Ha, Hb} =
- array.foldl(
- ( func(X, {HA0, HB0}) = {HA, HB} :-
- generic_double_hash(X, HXA, HXB),
- double_munge(HXA, HA0, HA, HXB, HB0, HB)
+ H = array.foldl(
+ ( func(X, HA0) = HA :-
+ generic_hash(X, HX),
+ munge(HX, HA0) = HA
),
Array,
- {0, 0}
+ 0
)
else
deconstruct(T, canonicalize, FunctorName, Arity, Args),
- string_double_hash(FunctorName, Ha0, Hb0),
- double_munge(Arity, Ha0, Ha1, Arity, Hb0, Hb1),
- list.foldl2(
- ( pred(U::in, HA0::in, HA::out, HB0::in, HB::out) is det :-
- generic_double_hash(U, HUA, HUB),
- double_munge(HUA, HA0, HA, HUB, HB0, HB)
+ string_hash(FunctorName, H0),
+ munge(Arity, H0) = H1,
+ list.foldl(
+ ( pred(U::in, HA0::in, HA::out) is det :-
+ generic_hash(U, HUA),
+ munge(HUA, HA0) = HA
),
Args,
- Ha1, Ha,
- Hb1, Hb
+ H1, H
)
).
%-----------------------------------------------------------------------------%
-:- func munge_factor_a = int.
+:- func munge(int, int) = int.
-munge_factor_a = 5.
+munge(N, X) =
+ (X `unchecked_left_shift` N) `xor`
+ (X `unchecked_right_shift` (int.bits_per_int - N)).
-:- func munge_factor_b = int.
+%-----------------------------------------------------------------------------%
-munge_factor_b = 3.
+fold(F, HT, X0) = X :-
+ foldl(fold_f(F), HT ^ buckets, X0, X).
-:- pred double_munge(int, int, int, int, int, int).
-:- mode double_munge(in, in, out, in, in, out) is det.
+:- pred fold_f(func(K, V, T) = T, assoc_list(K, V), T, T).
+:- mode fold_f(func(in, in, in) = out is det, in, in, out) is det.
+:- mode fold_f(func(in, in, di) = uo is det, in, di, uo) is det.
-double_munge(X, Ha0, Ha, Y, Hb0, Hb) :-
- Ha = munge(munge_factor_a, Ha0, X),
- Hb = munge(munge_factor_b, Hb0, Y).
+fold_f(_F, [], !A).
+fold_f(F, [K - V | KVs], !A) :-
+ F(K, V, !.A) = !:A,
+ fold_f(F, KVs, !A).
-:- func munge(int, int, int) = int.
-munge(N, X, Y) =
- (X `unchecked_left_shift` N) `xor`
- (X `unchecked_right_shift` (int.bits_per_int - N)) `xor`
- Y.
+fold(P, HT, !A) :-
+ foldl(fold_p(P), HT ^ buckets, !A).
-%-----------------------------------------------------------------------------%
+:- pred fold_p(pred(K, V, T, T), assoc_list(K, V), T, T).
+:- mode fold_p(pred(in, in, in, out) is det, in, in, out) is det.
+:- mode fold_p(pred(in, in, di, uo) is det, in, di, uo) is det.
-fold(Fn, HT, X) = fold_0(0, Fn, HT, X).
-
-:- func fold_0(int, func(K, V, T) = T, hash_table(K,V), T) = T.
-:- mode fold_0(in, func(in,in,in) = out is det, hash_table_ui, in) = out
- is det.
-:- mode fold_0(in, func(in,in,di) = uo is det, hash_table_ui, di) = uo
- is det.
-% :- mode fold_0(in, func(in,in,in) = out is det, in, in) = out is det.
-% :- mode fold_0(in, func(in,in,di) = uo is det, in, di) = uo is det.
-
-fold_0(I, Fn, HT, X) =
- ( if I >= HT ^ num_buckets then
- X
- else if bitmap.is_clear(HT ^ bitmap, I) then
- fold_0(I + 1, Fn, HT, X)
- else
- fold_0(I + 1, Fn, HT,
- Fn(HT ^ keys ^ elem(I), HT ^ values ^ elem(I), X))
- ).
+fold_p(_P, [], !A).
+fold_p(P, [K - V | KVs], !A) :-
+ P(K, V, !A),
+ fold_p(P, KVs, !A).
%-----------------------------------------------------------------------------%
diff --git a/library/robdd.m b/library/robdd.m
index 01bbd41..2982325 100644
--- a/library/robdd.m
+++ b/library/robdd.m
@@ -1126,10 +1126,10 @@ restrict_true_false_vars_2(TrueVars0,
FalseVars0, R0, R, Seen0, Seen) :-
Seen = det_insert(Seen2, R0, R)
).
-:- pred robdd_double_hash(robdd(T)::in, int::out, int::out) is det.
+:- pred robdd_hash(robdd(T)::in, int::out) is det.
-robdd_double_hash(R, H1, H2) :-
- int_double_hash(node_num(R), H1, H2).
+robdd_hash(R, H) :-
+ int_hash(node_num(R), H).
restrict_filter(P, F0) =
restrict_filter(P, (pred(_::in) is semidet :- true), F0).
diff --git a/library/version_array.m b/library/version_array.m
index 9ff878d..75a5468 100644
--- a/library/version_array.m
+++ b/library/version_array.m
@@ -109,6 +109,10 @@
%
:- func foldl(func(T1, T2) = T2, version_array(T1), T2) = T2.
+:- pred foldl(pred(T1, T2, T2), version_array(T1), T2, T2).
+:- mode foldl(pred(in, in, out) is det, in, in, out) is det.
+:- mode foldl(pred(in, di, uo) is det, in, di, uo) is det.
+
% foldr(F, A, X) is equivalent to list.foldr(F, list(A), Xs).
%
:- func foldr(func(T1, T2) = T2, version_array(T1), T2) = T2.
@@ -209,6 +213,23 @@ foldl_2(F, VA, Acc, Lo, Hi) =
%-----------------------------------------------------------------------------%
+foldl(P, VA, !Acc) :-
+ foldl_2(P, VA, 0, size(VA), !Acc).
+
+:- pred foldl_2(pred(T1, T2, T2), version_array(T1), int, int, T2, T2).
+:- mode foldl_2(pred(in, in, out) is det, in, in, in, in, out) is det.
+:- mode foldl_2(pred(in, di, uo) is det, in, in, in, di, uo) is det.
+
+foldl_2(P, VA, Lo, Hi, !Acc) :-
+ ( if Lo < Hi then
+ P(VA ^ elem(Lo), !Acc),
+ foldl_2(P, VA, Lo + 1, Hi, !Acc)
+ else
+ true
+ ).
+
+%-----------------------------------------------------------------------------%
+
foldr(F, VA, Acc) = foldr_2(F, VA, Acc, size(VA) - 1).
:- func foldr_2(func(T1, T2) = T2, version_array(T1), T2, int) = T2.
diff --git a/library/version_hash_table.m b/library/version_hash_table.m
index eca341f..70eb51f 100644
--- a/library/version_hash_table.m
+++ b/library/version_hash_table.m
@@ -6,7 +6,7 @@
%-----------------------------------------------------------------------------%
%
% File: version_hash_table.m.
-% Main author: rafe.
+% Main author: rafe, wangp.
% Stability: low.
%
% (See the header comments in version_types.m for an explanation of version
@@ -31,19 +31,16 @@
:- type version_hash_table(K, V).
-:- type hash_pred(K) == ( pred(K, int, int) ).
-:- inst hash_pred == ( pred(in, out, out) is det ).
+:- type hash_pred(K) == ( pred(K, int) ).
+:- inst hash_pred == ( pred(in, out) is det ).
- % new(HashFunc, N, MaxOccupancy)
+ % new(HashPred, N, MaxOccupancy)
% constructs a new hash table with initial size 2 ^ N that is
% doubled whenever MaxOccupancy is achieved; elements are
- % indexed using HashFunc.
+ % indexed using HashPred.
%
- % HashFunc must compute two *independent* hashes for a given
- % key - that is, one hash should not be a function of the other.
- % Otherwise poor performance will result.
- %
- % N must be greater than 1.
+ % HashPred must compute a hash for a given key.
+ % N must be greater than 0.
% MaxOccupancy must be in (0.0, 1.0).
%
% XXX Values too close to the limits may cause bad things
@@ -64,11 +61,11 @@
% Default hash_preds for ints and strings and everything (buwahahaha!)
%
-:- pred int_double_hash `with_type` hash_pred(int) `with_inst`
hash_pred.
-:- pred string_double_hash `with_type` hash_pred(string) `with_inst`
hash_pred.
-:- pred char_double_hash `with_type` hash_pred(char) `with_inst`
hash_pred.
-:- pred float_double_hash `with_type` hash_pred(float) `with_inst`
hash_pred.
-:- pred generic_double_hash `with_type` hash_pred(T) `with_inst`
hash_pred.
+:- pred int_hash(int::in, int::out) is det.
+:- pred string_hash(string::in, int::out) is det.
+:- pred char_hash(char::in, int::out) is det.
+:- pred float_hash(float::in, int::out) is det.
+:- pred generic_hash(T::in, int::out) is det.
% Returns the number of buckets in a hash table.
%
@@ -105,7 +102,6 @@
% exception is thrown if a binding for the key does not
% already exist. A predicate version is also provided.
%
- %
:- func det_update(version_hash_table(K, V), K, V) = version_hash_table(K, V).
:- pred det_update(K::in, V::in,
version_hash_table(K, V)::in, version_hash_table(K, V)::out)
@@ -138,16 +134,28 @@
%
:- func to_assoc_list(version_hash_table(K, V)) = assoc_list(K, V).
+ % Convert an association list into a hash table.
+ %
+:- func from_assoc_list(hash_pred(K)::in(hash_pred), assoc_list(K, V)::in) =
+ (version_hash_table(K, V)::out) is det.
+
% Fold a function over the key-value bindings in a hash table.
%
:- func fold(func(K, V, T) = T, version_hash_table(K, V), T) = T.
+ % Fold a predicate over the key-value bindings in a hash table.
+ %
+:- pred fold(pred(K, V, T, T), version_hash_table(K, V), T, T).
+:- mode fold(in(pred(in, in, in, out) is det), in, in, out) is det.
+:- mode fold(in(pred(in, in, di, uo) is det), in, di, uo) is det.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module array.
+:- import_module bool.
:- import_module deconstruct.
:- import_module exception.
:- import_module float.
@@ -164,51 +172,28 @@
:- type version_hash_table(K, V)
---> ht(
- num_buckets :: int,
num_occupants :: int,
max_occupants :: int,
hash_pred :: hash_pred(K),
- buckets :: buckets(K, V)
+ buckets :: version_array(assoc_list(K, V))
).
-:- type buckets(K, V) == version_array(bucket(K, V)).
-
-:- type bucket(K, V)
- ---> empty
- ; full(K, V).
-
-%-----------------------------------------------------------------------------%
-
- % THE HASHING SCHEME
- %
- % The user provided hashing function computes two independent
- % hashes H1 and H2 for a given key K.
- %
- % We calculate D = 2*H2 + 1 (to ensure that D is non-zero and
- % odd and is therefore coprime to the number of buckets) and
- % probe the table where the Kth probe examines slot
- %
- % (H1 + K * H2) `mod` num_buckets
- %
- % The search is guaranteed to terminate because table occupancy
- % must be less than 1.0.
-
%-----------------------------------------------------------------------------%
new(HashPred, N, MaxOccupancy) = HT :-
- ( if N =< 1 then
- throw(software_error("version_hash_table.new: N =< 1"))
+ ( if N =< 0 then
+ throw(software_error("version_hash_table.new_hash_table: N =< 0"))
else if N >= int.bits_per_int then
throw(software_error(
"version_hash_table.new: N >= int.bits_per_int"))
- else if MaxOccupancy =< 0.0 ; 1.0 =< MaxOccupancy then
+ else if MaxOccupancy =< 0.0 then
throw(software_error(
- "version_hash_table.new: MaxOccupancy not in (0.0, 1.0)"))
+ "version_hash_table.new: MaxOccupancy =< 0.0"))
else
NumBuckets = 1 << N,
MaxOccupants = ceiling_to_int(float(NumBuckets) * MaxOccupancy),
- VArray = version_array.init(NumBuckets, empty),
- HT = ht(NumBuckets, 0, MaxOccupants, HashPred, VArray)
+ Buckets = init(NumBuckets, []),
+ HT = ht(0, MaxOccupants, HashPred, Buckets)
).
%-----------------------------------------------------------------------------%
@@ -219,42 +204,23 @@ new_default(HashPred) = new(HashPred, 7, 0.9).
%-----------------------------------------------------------------------------%
- % find_slot(HT, K) looks up key K in hash table HT and
- % returns the index for the entry K in H. This is either the
- % first free slot identified (K is not in the table, but here
- % is where it would go) or the slot for K (K is in the table
- % and this is its slot).
- %
- % Whether or not K is actually in the table can be decided
- % by checking to see whether its bit in the vbitmap is set
- % or clear.
- %
+num_buckets(HT) = size(HT ^ buckets).
+
+%-----------------------------------------------------------------------------%
+
:- func find_slot(version_hash_table(K, V), K) = int.
find_slot(HT, K) = H :-
unsafe_hash_pred_cast(HT ^ hash_pred, HashPred),
- HashPred(K, Hash1, Hash2),
- H0 = Hash1 mod HT ^ num_buckets,
- % Have to ensure it's odd and non-zero.
- Delta = Hash2 + Hash2 + 1,
- H = find_slot_2(HT, K, H0, Delta).
+ find_slot_2(HashPred, K, HT ^ num_buckets, H).
-:- func find_slot_2(version_hash_table(K, V), K, int, int) = int.
+:- pred find_slot_2(hash_pred(K)::in(hash_pred), K::in, int::in, int::out)
+ is det.
-find_slot_2(HT, K, H0, Delta) = H :-
- B = HT ^ buckets ^ elem(H0),
- (
- B = empty,
- H = H0
- ;
- B = full(Key, _Value),
- ( if K = Key then
- H = H0
- else
- H1 = (H0 + Delta) mod HT ^ num_buckets,
- H = find_slot_2(HT, K, H1, Delta)
- )
- ).
+find_slot_2(HashPred, K, NumBuckets, H) :-
+ HashPred(K, Hash),
+ % Since NumBuckets is a power of two we can avoid mod.
+ H = Hash /\ (NumBuckets - 1).
:- pred unsafe_hash_pred_cast(hash_pred(K)::in, hash_pred(K)::out(hash_pred))
is det.
@@ -268,26 +234,22 @@ find_slot_2(HT, K, H0, Delta) = H :-
%-----------------------------------------------------------------------------%
-set(HT0, K, V) = HT :-
-
- % If this is the first entry in the hash table, then we use it to set
- % up the hash table (the version_arrays are currently empty because we
- % need values to initialise them with).
- %
- H = find_slot(HT0, K),
- B = HT0 ^ buckets ^ elem(H),
+set(!.HT, K, V) = !:HT :-
+ H = find_slot(!.HT, K),
+ AL0 = !.HT ^ buckets ^ elem(H),
+ ( if assoc_list.remove(AL0, K, _, AL1) then
+ AL = [K - V | AL1],
+ MayExpand = no
+ else
+ AL = [K - V | AL0],
+ MayExpand = yes
+ ),
+ !HT ^ buckets ^ elem(H) := AL,
(
- B = empty,
- HT =
- ( if HT0 ^ num_occupants = HT0 ^ max_occupants then
- set(expand(HT0), K, V)
- else
- (( HT0 ^ num_occupants := HT0 ^ num_occupants + 1 )
- ^ buckets ^ elem(H) := full(K, V) )
- )
+ MayExpand = no
;
- B = full(_, _),
- HT = ( HT0 ^ buckets ^ elem(H) := full(K, V) )
+ MayExpand = yes,
+ increase_occupants(!HT)
).
'elem :='(K, HT, V) = set(HT, K, V).
@@ -300,26 +262,22 @@ search(HT, K, search(HT, K)).
search(HT, K) = V :-
H = find_slot(HT, K),
- HT ^ buckets ^ elem(H) = full(K, V).
+ AL = HT ^ buckets ^ elem(H),
+ assoc_list.search(AL, K, V).
%-----------------------------------------------------------------------------%
-det_insert(HT0, K, V) = HT :-
- H = find_slot(HT0, K),
- B = HT0 ^ buckets ^ elem(H),
- (
- B = full(_, _),
- error("version_hash_table.det_update: key already present")
- ;
- B = empty,
- HT =
- ( if HT0 ^ num_occupants = HT0 ^ max_occupants then
- set(expand(HT0), K, V)
- else
- (( HT0 ^ num_occupants := HT0 ^ num_occupants + 1 )
- ^ buckets ^ elem(H) := full(K, V) )
- )
- ).
+det_insert(!.HT, K, V) = !:HT :-
+ H = find_slot(!.HT, K),
+ AL0 = !.HT ^ buckets ^ elem(H),
+ ( if assoc_list.search(AL0, K, _) then
+ throw(software_error(
+ "version_hash_table.det_insert: key already present"))
+ else
+ AL = [K - V | AL0]
+ ),
+ !HT ^ buckets ^ elem(H) := AL,
+ increase_occupants(!HT).
det_insert(K, V, HT, det_insert(HT, K, V)).
@@ -327,14 +285,13 @@ det_insert(K, V, HT, det_insert(HT, K, V)).
det_update(HT0, K, V) = HT :-
H = find_slot(HT0, K),
- B = HT0 ^ buckets ^ elem(H),
- (
- B = empty,
- error("version_hash_table.det_update: key not found")
- ;
- B = full(_, _),
- HT = ( HT0 ^ buckets ^ elem(H) := full(K, V) )
- ).
+ AL0 = HT0 ^ buckets ^ elem(H),
+ ( if assoc_list.remove(AL0, K, _, AL1) then
+ AL = [K - V | AL1]
+ else
+ throw(software_error("version_hash_table.det_update: key not found"))
+ ),
+ HT = HT0 ^ buckets ^ elem(H) := AL.
det_update(K, V, HT, det_update(HT, K, V)).
@@ -346,177 +303,249 @@ lookup(HT, K) =
else func_error("version_hash_table.lookup: key not found")
).
-HT ^ elem(K) = lookup(HT, K).
+elem(K, HT) = lookup(HT, K).
%-----------------------------------------------------------------------------%
-delete(HT, K) =
- HT ^ buckets ^ elem(find_slot(HT, K)) := empty.
+delete(HT0, K) = HT :-
+ H = find_slot(HT0, K),
+ AL0 = HT0 ^ buckets ^ elem(H),
+ ( if assoc_list.remove(AL0, K, _, AL) then
+ HT0 = ht(NumOccupants0, MaxOccupants, HashPred, Buckets0),
+ Buckets = Buckets0 ^ elem(H) := AL,
+ NumOccupants = NumOccupants0 - 1,
+ HT = ht(NumOccupants, MaxOccupants, HashPred, Buckets)
+ else
+ HT = HT0
+ ).
delete(K, HT, delete(HT, K)).
%-----------------------------------------------------------------------------%
to_assoc_list(HT) =
- fold_up(cons_k_v(HT ^ buckets), 0, HT ^ num_buckets - 1, []).
+ foldl(list.append, HT ^ buckets, []).
-:- func cons_k_v(version_array(bucket(K, V)), int, assoc_list(K, V)) =
- assoc_list(K, V).
-cons_k_v(Bs, I, KVs) =
- ( if Bs ^ elem(I) = full(K, V)
- then [K - V | KVs]
- else KVs
- ).
+from_assoc_list(HP, AList) = from_assoc_list_2(AList, new_default(HP)).
+
+:- func from_assoc_list_2(assoc_list(K, V), version_hash_table(K, V))
+ = version_hash_table(K, V).
+
+from_assoc_list_2([], HT) = HT.
+
+from_assoc_list_2([K - V | AList], HT) =
+ from_assoc_list_2(AList, HT ^ elem(K) := V).
%-----------------------------------------------------------------------------%
+:- pred increase_occupants(version_hash_table(K, V), version_hash_table(K, V)).
+:- mode increase_occupants(in, out) is det.
+
+increase_occupants(!HT) :-
+ NumOccupants = !.HT ^ num_occupants,
+ MaxOccupants = !.HT ^ max_occupants,
+ ( if NumOccupants = MaxOccupants then
+ expand(!HT)
+ else
+ !HT ^ num_occupants := NumOccupants + 1
+ ).
+
% Hash tables expand by doubling in size.
%
-:- func expand(version_hash_table(K, V)) = version_hash_table(K, V).
+:- pred expand(version_hash_table(K, V), version_hash_table(K, V)).
+:- mode expand(in, out) is det.
-expand(HT0) = HT :-
+expand(HT0, HT) :-
+ HT0 = ht(NumOccupants0, MaxOccupants0, HashPred0, Buckets0),
- HT0 = ht(NBs0, _NOs, MOs0, HF, Bs0),
+ NumBuckets0 = size(Buckets0),
+ NumBuckets = NumBuckets0 + NumBuckets0,
+ MaxOccupants = MaxOccupants0 + MaxOccupants0,
- NBs = NBs0 + NBs0,
- MOs = MOs0 + MOs0,
- Bs1 = version_array.init(NBs, empty),
+ unsafe_hash_pred_cast(HashPred0, HashPred),
+ Buckets1 = init(NumBuckets, []),
+ reinsert_bindings(0, Buckets0, HashPred, NumBuckets, Buckets1, Buckets),
- HT1 = ht(NBs, 0, MOs, HF, Bs1),
+ HT = ht(NumOccupants0 + 1, MaxOccupants, HashPred, Buckets).
- HT = fold_up(reinsert_k_v(Bs0), 0, NBs0 - 1, HT1).
+:- pred reinsert_bindings(int, version_array(assoc_list(K, V)), hash_pred(K),
+ int, version_array(assoc_list(K, V)), version_array(assoc_list(K,V))).
+:- mode reinsert_bindings(in, in, in(hash_pred),
+ in, in, out) is det.
-:- func reinsert_k_v(buckets(K, V), int, version_hash_table(K, V)) =
- version_hash_table(K, V).
-
-reinsert_k_v(Bs, I, HT) =
- ( if Bs ^ elem(I) = full(K, V)
- then HT ^ elem(K) := V
- else HT
+reinsert_bindings(I, OldBuckets, HashPred, NumBuckets, !Buckets) :-
+ ( if I >= size(OldBuckets) then
+ true
+ else
+ AL = OldBuckets ^ elem(I),
+ reinsert_assoc_list(AL, HashPred, NumBuckets, !Buckets),
+ reinsert_bindings(I + 1, OldBuckets, HashPred, NumBuckets, !Buckets)
).
+:- pred reinsert_assoc_list(assoc_list(K, V), hash_pred(K),
+ int, version_array(assoc_list(K, V)), version_array(assoc_list(K, V))).
+:- mode reinsert_assoc_list(in, in(hash_pred),
+ in, in, out) is det.
+
+reinsert_assoc_list([], _, _, !Buckets).
+reinsert_assoc_list([KV | KVs], HashPred, NumBuckets, !Buckets) :-
+ unsafe_insert(KV, HashPred, NumBuckets, !Buckets),
+ reinsert_assoc_list(KVs, HashPred, NumBuckets, !Buckets).
+
+:- pred unsafe_insert(pair(K, V), hash_pred(K),
+ int, version_array(assoc_list(K, V)), version_array(assoc_list(K, V))).
+:- mode unsafe_insert(in, in(hash_pred),
+ in, in, out) is det.
+
+unsafe_insert(KV, HashPred, NumBuckets, Buckets0, Buckets) :-
+ KV = K - _,
+ find_slot_2(HashPred, K, NumBuckets, H),
+ AL0 = Buckets0 ^ elem(H),
+ Buckets = Buckets0 ^ elem(H) := [KV | AL0].
+
%-----------------------------------------------------------------------------%
% There are almost certainly better ones out there...
%
- % NOTE that H1 \= N since neither of H1 or H2 should be a function
- % of the other under machine integer arithmetic.
+int_hash(N, N).
+
+ % From http://www.concentric.net/~Ttwang/tech/inthash.htm
+ % public int hash32shift(int key)
+ % public long hash64shift(long key)
%
-int_double_hash(N, H1, H2) :-
- H1 = N * N,
- H2 = N `xor` (N + N).
+:- pragma foreign_proc("C",
+ int_hash(N::in, H::out),
+ [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
+"
+ const int c2 = 0x27d4eb2d; /* a prime or an odd constant */
+ MR_Unsigned key;
+
+ key = N;
+
+ if (sizeof(MR_Word) == 4) {
+ key = (key ^ 61) ^ (key >> 16);
+ key = key + (key << 3);
+ key = key ^ (key >> 4);
+ key = key * c2;
+ key = key ^ (key >> 15);
+ } else {
+ key = (~key) + (key << 21); /* key = (key << 21) - key - 1; */
+ key = key ^ (key >> 24);
+ key = (key + (key << 3)) + (key << 8); /* key * 265 */
+ key = key ^ (key >> 14);
+ key = (key + (key << 2)) + (key << 4); /* key * 21 */
+ key = key ^ (key >> 28);
+ key = key + (key << 31);
+ }
+
+ H = key;
+").
%-----------------------------------------------------------------------------%
% There are almost certainly better ones out there...
%
-string_double_hash(S, H1, H2) :-
- H1 = string.hash(S),
- H2 = string.foldl(func(C, N) = char.to_int(C) + N, S, 0).
+string_hash(S, string.hash(S)).
-%------------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
% There are almost certainly better ones out there...
%
-float_double_hash(F, H1, H2) :-
- H1 = float.hash(F),
- H2 = float.hash(F * F).
+float_hash(F, float.hash(F)).
-%------------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
% There are almost certainly better ones out there...
%
-char_double_hash(C, H1, H2) :-
- int_double_hash(char.to_int(C), H1, H2).
+char_hash(C, H) :-
+ int_hash(char.to_int(C), H).
%-----------------------------------------------------------------------------%
% This, again, is straight off the top of my head.
%
-generic_double_hash(T, Ha, Hb) :-
+generic_hash(T, H) :-
( if dynamic_cast(T, Int) then
- int_double_hash(Int, Ha, Hb)
+ int_hash(Int, H)
else if dynamic_cast(T, String) then
- string_double_hash(String, Ha, Hb)
+ string_hash(String, H)
else if dynamic_cast(T, Float) then
- float_double_hash(Float, Ha, Hb)
+ float_hash(Float, H)
else if dynamic_cast(T, Char) then
- char_double_hash(Char, Ha, Hb)
+ char_hash(Char, H)
else if dynamic_cast(T, Univ) then
- generic_double_hash(univ_value(Univ), Ha, Hb)
+ generic_hash(univ_value(Univ), H)
else if dynamic_cast_to_array(T, Array) then
- {Ha, Hb} =
- array.foldl(
- ( func(X, {HA0, HB0}) = {HA, HB} :-
- generic_double_hash(X, HXA, HXB),
- double_munge(HXA, HA0, HA, HXB, HB0, HB)
+ H = array.foldl(
+ ( func(X, HA0) = HA :-
+ generic_hash(X, HX),
+ munge(HX, HA0) = HA
),
Array,
- {0, 0}
+ 0
)
else
deconstruct(T, canonicalize, FunctorName, Arity, Args),
- string_double_hash(FunctorName, Ha0, Hb0),
- double_munge(Arity, Ha0, Ha1, Arity, Hb0, Hb1),
- list.foldl2(
- ( pred(U::in, HA0::in, HA::out, HB0::in, HB::out) is det :-
- generic_double_hash(U, HUA, HUB),
- double_munge(HUA, HA0, HA, HUB, HB0, HB)
+ string_hash(FunctorName, H0),
+ munge(Arity, H0) = H1,
+ list.foldl(
+ ( pred(U::in, HA0::in, HA::out) is det :-
+ generic_hash(U, HUA),
+ munge(HUA, HA0) = HA
),
Args,
- Ha1, Ha,
- Hb1, Hb
+ H1, H
)
).
%-----------------------------------------------------------------------------%
-:- func munge_factor_a = int.
-munge_factor_a = 5.
+:- func munge(int, int) = int.
-:- func munge_factor_b = int.
-munge_factor_b = 3.
+munge(N, X) =
+ (X `unchecked_left_shift` N) `xor`
+ (X `unchecked_right_shift` (int.bits_per_int - N)).
-:- pred double_munge(int::in, int::in, int::out, int::in, int::in, int::out)
- is det.
+%-----------------------------------------------------------------------------%
-double_munge(X, Ha0, Ha, Y, Hb0, Hb) :-
- Ha = munge(munge_factor_a, Ha0, X),
- Hb = munge(munge_factor_b, Hb0, Y).
+fold(F, HT, X0) = X :-
+ foldl(fold_f(F), HT ^ buckets, X0, X).
-:- func munge(int, int, int) = int.
+:- pred fold_f(func(K, V, T) = T, assoc_list(K, V), T, T).
+:- mode fold_f(func(in, in, in) = out is det, in, in, out) is det.
+:- mode fold_f(func(in, in, di) = uo is det, in, di, uo) is det.
-munge(N, X, Y) =
- (X `unchecked_left_shift` N) `xor`
- (X `unchecked_right_shift` (int.bits_per_int - N)) `xor`
- Y.
+fold_f(_F, [], !A).
+fold_f(F, [K - V | KVs], !A) :-
+ F(K, V, !.A) = !:A,
+ fold_f(F, KVs, !A).
-%-----------------------------------------------------------------------------%
-fold(Fn, HT, X) =
- fold_up(apply_k_v(Fn, HT ^ buckets), 0, HT ^ num_buckets - 1, X).
+fold(P, HT, !A) :-
+ foldl(fold_p(P), HT ^ buckets, !A).
-:- func apply_k_v(func(K, V, T) = T, buckets(K, V), int, T) = T.
+:- pred fold_p(pred(K, V, T, T), assoc_list(K, V), T, T).
+:- mode fold_p(pred(in, in, in, out) is det, in, in, out) is det.
+:- mode fold_p(pred(in, in, di, uo) is det, in, di, uo) is det.
-apply_k_v(Fn, Bs, I, A) =
- ( if Bs ^ elem(I) = full(K, V)
- then Fn(K, V, A)
- else A
- ).
+fold_p(_P, [], !A).
+fold_p(P, [K - V | KVs], !A) :-
+ P(K, V, !A),
+ fold_p(P, KVs, !A).
%-----------------------------------------------------------------------------%
diff --git a/tests/hard_coded/Mmakefile b/tests/hard_coded/Mmakefile
index 0af8ccf..215a7eb 100644
--- a/tests/hard_coded/Mmakefile
+++ b/tests/hard_coded/Mmakefile
@@ -109,6 +109,8 @@ ORDINARY_PROGS= \
ground_dd \
hash_bug \
hash_init_bug \
+ hash_table_delete \
+ hash_table_test \
higher_order_func_test \
higher_order_syntax \
higher_order_syntax2 \
@@ -543,7 +545,9 @@ ifeq "$(findstring profdeep,$(GRADE))" ""
try_syntax_7 \
user_defined_equality \
version_array_test \
+ version_hash_table_delete \
version_hash_table_test \
+ version_hash_table_test2 \
write_binary
else
NON_PROFDEEP_PROGS =
diff --git a/tests/hard_coded/hash_bug.m b/tests/hard_coded/hash_bug.m
index 44cec1e..1e1eb75 100644
--- a/tests/hard_coded/hash_bug.m
+++ b/tests/hard_coded/hash_bug.m
@@ -12,10 +12,9 @@
:- import_module map, require, std_util, string.
main(!IO) :-
- HashPred = (pred(Name::in, Hash1::out, Hash2::out) is det :-
+ HashPred = (pred(Name::in, Hash::out) is det :-
sym_name_to_string(Name, ".", Str),
- Hash1 = hash(Str),
- Hash2 = hash(from_rev_char_list(to_char_list(Str)))
+ Hash = hash(Str)
),
HT0 = new(HashPred, 10, 0.8),
build_table(entries, HT0, HT),
diff --git a/tests/hard_coded/hash_init_bug.m b/tests/hard_coded/hash_init_bug.m
index 8249ca6..1fd452c 100644
--- a/tests/hard_coded/hash_init_bug.m
+++ b/tests/hard_coded/hash_init_bug.m
@@ -12,10 +12,9 @@
:- import_module map, require, std_util, string.
main(!IO) :-
- HashPred = (pred(Name::in, Hash1::out, Hash2::out) is det :-
+ HashPred = (pred(Name::in, Hash::out) is det :-
sym_name_to_string(Name, ".", Str),
- Hash1 = hash(Str),
- Hash2 = hash(from_rev_char_list(to_char_list(Str)))
+ Hash = hash(Str)
),
HT0 = new(HashPred, 10, 0.8),
build_table(entries, HT0, HT),
diff --git a/tests/hard_coded/hash_table_delete.exp
b/tests/hard_coded/hash_table_delete.exp
new file mode 100644
index 0000000..fe51488
--- /dev/null
+++ b/tests/hard_coded/hash_table_delete.exp
@@ -0,0 +1 @@
+[]
diff --git a/tests/hard_coded/hash_table_delete.m
b/tests/hard_coded/hash_table_delete.m
new file mode 100644
index 0000000..660151a
--- /dev/null
+++ b/tests/hard_coded/hash_table_delete.m
@@ -0,0 +1,54 @@
+%-----------------------------------------------------------------------------%
+
+:- module hash_table_delete.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module list.
+:- import_module string.
+:- import_module hash_table.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ some [!HT] (
+ !:HT = hash_table.new_default(generic_hash),
+ myfoldl(fill, keys, !HT),
+ myfoldl(hash_table.delete, keys, !HT),
+ Residue = hash_table.to_assoc_list(!.HT),
+ io.write(Residue, !IO),
+ io.nl(!IO)
+ ).
+
+
+:- pred myfoldl(pred(T, A, A), list(T), A, A).
+:- mode myfoldl(in(pred(in, hash_table_di, hash_table_uo) is det), in,
+ hash_table_di, hash_table_uo) is det.
+
+myfoldl(_, [], !HT).
+myfoldl(P, [T | Ts], !HT) :-
+ P(T, !HT),
+ myfoldl(P, Ts, !HT).
+
+:- func keys = list(string).
+
+keys =
+ ["aback", "abaft", "abandon", "abandoned", "abandoning", "abandonment",
+ "abandons", "abase", "abased", "abasement", "abasements", "abases"].
+
+:- pred fill(string::in, hash_table(string, int)::hash_table_di,
+ hash_table(string, int)::hash_table_uo) is det.
+
+fill(Key, !HT) :-
+ hash_table.det_insert(Key, string.length(Key), !HT).
+
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=8 sw=4 et wm=0 tw=0
diff --git a/tests/hard_coded/hash_table_test.exp
b/tests/hard_coded/hash_table_test.exp
new file mode 100644
index 0000000..6a67c38
--- /dev/null
+++ b/tests/hard_coded/hash_table_test.exp
@@ -0,0 +1,5 @@
+Inserting elements
+Looking up elements
+Deleting some elements
+Replacing elements
+Looking up elements
diff --git a/tests/hard_coded/hash_table_test.m
b/tests/hard_coded/hash_table_test.m
new file mode 100644
index 0000000..f9b6f09
--- /dev/null
+++ b/tests/hard_coded/hash_table_test.m
@@ -0,0 +1,151 @@
+%-----------------------------------------------------------------------------%
+
+:- module hash_table_test.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module benchmarking.
+:- import_module int.
+:- import_module list.
+:- import_module hash_table.
+:- import_module require.
+:- import_module string.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ io.command_line_arguments(Args, !IO),
+ (
+ Args = [],
+ A = "1000000",
+ B = "0.9"
+ ;
+ Args = [A],
+ B = "0.9"
+ ;
+ Args = [A, B | _]
+ ),
+ Max = string.det_to_int(A),
+ MaxOccupancy = string.det_to_float(B),
+ some [!HT] (
+ !:HT = hash_table.new(int_hash, 1, MaxOccupancy),
+
+ io.write_string("Inserting elements\n", !IO),
+ int.fold_up(do_insert, 0, Max - 1, !HT),
+ trace [io(!IO), runtime(env("HASH_TABLE_STATS"))] (
+ impure report_stats
+ ),
+
+ io.write_string("Looking up elements\n", !IO),
+ int.fold_up(do_lookup, 0, Max - 1, !HT),
+ trace [io(!IO), runtime(env("HASH_TABLE_STATS"))] (
+ impure report_stats
+ ),
+
+ unsafe_hash_table_cast(!HT),
+
+ NumOccupants0 = hash_table.num_occupants(!.HT),
+ ( NumOccupants0 = Max ->
+ true
+ ;
+ error("num_occupants failed")
+ ),
+
+ Half = Max / 2,
+ io.write_string("Deleting some elements\n", !IO),
+ int.fold_up(do_delete, 0, Half - 1, !HT),
+ trace [io(!IO), runtime(env("HASH_TABLE_STATS"))] (
+ impure report_stats
+ ),
+
+ unsafe_hash_table_cast(!HT),
+
+ NumOccupants = hash_table.num_occupants(!.HT),
+ ( NumOccupants = Max - Half ->
+ true
+ ;
+ error("num_occupants failed")
+ ),
+
+ AL = hash_table.to_assoc_list(!.HT),
+ ( list.length(AL) = NumOccupants ->
+ true
+ ;
+ error("to_assoc_list failed")
+ ),
+
+ io.write_string("Replacing elements\n", !IO),
+ int.fold_up(do_replace_neg, 0, Max - 1, !HT),
+ trace [io(!IO), runtime(env("HASH_TABLE_STATS"))] (
+ impure report_stats
+ ),
+
+ io.write_string("Looking up elements\n", !IO),
+ int.fold_up(do_lookup_neg, 0, Max - 1, !HT),
+ trace [io(!IO), runtime(env("HASH_TABLE_STATS"))] (
+ impure report_stats
+ ),
+
+ _ = !.HT
+ ).
+
+:- pred do_insert(int::in, hash_table(int, int)::hash_table_di,
+ hash_table(int, int)::hash_table_uo) is det.
+
+do_insert(I, !HT) :-
+ hash_table.det_insert(I, I, !HT).
+
+:- pred do_lookup(int::in, hash_table(int, int)::hash_table_di,
+ hash_table(int, int)::hash_table_uo) is det.
+
+do_lookup(I, !HT) :-
+ V = hash_table.lookup(!.HT, I),
+ ( I = V ->
+ true
+ ;
+ error("do_lookup failed")
+ ).
+
+:- pred do_lookup_neg(int::in, hash_table(int, int)::hash_table_di,
+ hash_table(int, int)::hash_table_uo) is det.
+
+do_lookup_neg(I, !HT) :-
+ V = hash_table.lookup(!.HT, I),
+ ( -I = V ->
+ true
+ ;
+ error("do_lookup failed")
+ ).
+
+:- pred do_delete(int::in, hash_table(int, int)::hash_table_di,
+ hash_table(int, int)::hash_table_uo) is det.
+
+do_delete(I, !HT) :-
+ hash_table.delete(I, !HT).
+
+:- pred do_replace_neg(int::in, hash_table(int, int)::hash_table_di,
+ hash_table(int, int)::hash_table_uo) is det.
+
+do_replace_neg(I, !HT) :-
+ hash_table.set(I, -I, !HT).
+
+:- pred unsafe_hash_table_cast(hash_table(T, T)::in,
+ hash_table(T, T)::out(hash_table)) is det.
+
+:- pragma foreign_proc("C",
+ unsafe_hash_table_cast(HT0::in, HT::out(hash_table)),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ HT = HT0;
+").
+
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=8 sts=4 sw=4 et
diff --git a/tests/hard_coded/version_hash_table_delete.exp
b/tests/hard_coded/version_hash_table_delete.exp
new file mode 100644
index 0000000..fe51488
--- /dev/null
+++ b/tests/hard_coded/version_hash_table_delete.exp
@@ -0,0 +1 @@
+[]
diff --git a/tests/hard_coded/version_hash_table_delete.m
b/tests/hard_coded/version_hash_table_delete.m
new file mode 100644
index 0000000..0bd69c5
--- /dev/null
+++ b/tests/hard_coded/version_hash_table_delete.m
@@ -0,0 +1,44 @@
+%-----------------------------------------------------------------------------%
+
+:- module version_hash_table_delete.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module list.
+:- import_module string.
+:- import_module version_hash_table.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ some [!HT] (
+ !:HT = version_hash_table.new_default(generic_hash),
+ list.foldl(fill, keys, !HT),
+ list.foldl(version_hash_table.delete, keys, !HT),
+ Residue = version_hash_table.to_assoc_list(!.HT),
+ io.write(Residue, !IO),
+ io.nl(!IO)
+ ).
+
+:- func keys = list(string).
+
+keys =
+ ["aback", "abaft", "abandon", "abandoned", "abandoning", "abandonment",
+ "abandons", "abase", "abased", "abasement", "abasements", "abases"].
+
+:- pred fill(string::in, version_hash_table(string, int)::in,
+ version_hash_table(string, int)::out) is det.
+
+fill(Key, !HT) :-
+ version_hash_table.det_insert(Key, string.length(Key), !HT).
+
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=8 sw=4 et wm=0 tw=0
diff --git a/tests/hard_coded/version_hash_table_test.m
b/tests/hard_coded/version_hash_table_test.m
index eefd049..691d22e 100644
--- a/tests/hard_coded/version_hash_table_test.m
+++ b/tests/hard_coded/version_hash_table_test.m
@@ -24,7 +24,7 @@
main(!IO) :-
% Test `fold' which had an off-by-one bug.
some [!HT] (
- !:HT = version_hash_table.new_default(generic_double_hash),
+ !:HT = version_hash_table.new_default(generic_hash),
version_hash_table.set("one", 1, !HT),
version_hash_table.set("two", 2, !HT),
version_hash_table.set("three", 3, !HT),
diff --git a/tests/hard_coded/version_hash_table_test2.exp
b/tests/hard_coded/version_hash_table_test2.exp
new file mode 100644
index 0000000..6a67c38
--- /dev/null
+++ b/tests/hard_coded/version_hash_table_test2.exp
@@ -0,0 +1,5 @@
+Inserting elements
+Looking up elements
+Deleting some elements
+Replacing elements
+Looking up elements
diff --git a/tests/hard_coded/version_hash_table_test2.m
b/tests/hard_coded/version_hash_table_test2.m
new file mode 100644
index 0000000..e04fa2b
--- /dev/null
+++ b/tests/hard_coded/version_hash_table_test2.m
@@ -0,0 +1,137 @@
+%-----------------------------------------------------------------------------%
+
+:- module version_hash_table_test.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module benchmarking.
+:- import_module int.
+:- import_module list.
+:- import_module version_hash_table.
+:- import_module require.
+:- import_module string.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ io.command_line_arguments(Args, !IO),
+ (
+ Args = [],
+ A = "1000000",
+ B = "0.9"
+ ;
+ Args = [A],
+ B = "0.9"
+ ;
+ Args = [A, B | _]
+ ),
+ Max = string.det_to_int(A),
+ MaxOccupancy = string.det_to_float(B),
+ some [!HT] (
+ !:HT = version_hash_table.new(int_hash, 1, MaxOccupancy),
+
+ io.write_string("Inserting elements\n", !IO),
+ int.fold_up(do_insert, 0, Max - 1, !HT),
+ trace [io(!IO), runtime(env("HASH_TABLE_STATS"))] (
+ impure report_stats
+ ),
+
+ io.write_string("Looking up elements\n", !IO),
+ int.fold_up(do_lookup, 0, Max - 1, !HT),
+ trace [io(!IO), runtime(env("HASH_TABLE_STATS"))] (
+ impure report_stats
+ ),
+
+ NumOccupants0 = version_hash_table.num_occupants(!.HT),
+ ( NumOccupants0 = Max ->
+ true
+ ;
+ error("num_occupants failed")
+ ),
+
+ Half = Max / 2,
+ io.write_string("Deleting some elements\n", !IO),
+ int.fold_up(do_delete, 0, Half - 1, !HT),
+ trace [io(!IO), runtime(env("HASH_TABLE_STATS"))] (
+ impure report_stats
+ ),
+
+ NumOccupants = version_hash_table.num_occupants(!.HT),
+ ( NumOccupants = Max - Half ->
+ true
+ ;
+ error("num_occupants failed")
+ ),
+
+ AL = version_hash_table.to_assoc_list(!.HT),
+ ( list.length(AL) = NumOccupants ->
+ true
+ ;
+ error("to_assoc_list failed")
+ ),
+
+ io.write_string("Replacing elements\n", !IO),
+ int.fold_up(do_replace_neg, 0, Max - 1, !HT),
+ trace [io(!IO), runtime(env("HASH_TABLE_STATS"))] (
+ impure report_stats
+ ),
+
+ io.write_string("Looking up elements\n", !IO),
+ int.fold_up(do_lookup_neg, 0, Max - 1, !HT),
+ trace [io(!IO), runtime(env("HASH_TABLE_STATS"))] (
+ impure report_stats
+ ),
+
+ _ = !.HT
+ ).
+
+:- pred do_insert(int::in, version_hash_table(int, int)::in,
+ version_hash_table(int, int)::out) is det.
+
+do_insert(I, !HT) :-
+ version_hash_table.det_insert(I, I, !HT).
+
+:- pred do_lookup(int::in, version_hash_table(int, int)::in,
+ version_hash_table(int, int)::out) is det.
+
+do_lookup(I, !HT) :-
+ V = version_hash_table.lookup(!.HT, I),
+ ( I = V ->
+ true
+ ;
+ error("do_lookup failed")
+ ).
+
+:- pred do_lookup_neg(int::in, version_hash_table(int, int)::in,
+ version_hash_table(int, int)::out) is det.
+
+do_lookup_neg(I, !HT) :-
+ V = version_hash_table.lookup(!.HT, I),
+ ( -I = V ->
+ true
+ ;
+ error("do_lookup failed")
+ ).
+
+:- pred do_delete(int::in, version_hash_table(int, int)::in,
+ version_hash_table(int, int)::out) is det.
+
+do_delete(I, !HT) :-
+ version_hash_table.delete(I, !HT).
+
+:- pred do_replace_neg(int::in, version_hash_table(int, int)::in,
+ version_hash_table(int, int)::out) is det.
+
+do_replace_neg(I, !HT) :-
+ version_hash_table.set(I, -I, !HT).
+
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=8 sts=4 sw=4 et
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list