[m-rev.] for review: Define equality for version_hash_tables
Paul Bone
paul at bone.id.au
Mon May 27 10:45:40 AEST 2013
For review by anyone.
Define equality for version_hash_tables.
library/version_hash_table.m:
Add user-defined equality to the version_hash_table/2 type.
Use a notag type to make deconstructions easier.
Introduce a new function to handle deconstructions that promise that all
theoretical solutions are equivilent.
Rename fields of the inner structure as the num_occupants function
no-longer has the same type as the function generated by the field of
the same name.
---
library/version_hash_table.m | 126 ++++++++++++++++++++++++++++++++++---------
1 file changed, 102 insertions(+), 24 deletions(-)
diff --git a/library/version_hash_table.m b/library/version_hash_table.m
index 04d3389..3640ca5 100644
--- a/library/version_hash_table.m
+++ b/library/version_hash_table.m
@@ -226,17 +226,22 @@
:- import_module require.
:- import_module string.
:- import_module type_desc.
+:- import_module unit.
:- import_module univ.
:- import_module version_array.
%-----------------------------------------------------------------------------%
:- type version_hash_table(K, V)
+ ---> ht_outer(ht_inner(K, V))
+ where equality is version_hash_table_equals.
+
+:- type ht_inner(K, V)
---> ht(
- num_occupants :: int,
- max_occupants :: int,
- hash_pred :: hash_pred(K),
- buckets :: buckets(K, V)
+ ht_num_occupants :: int,
+ ht_max_occupants :: int,
+ ht_hash_pred :: hash_pred(K),
+ ht_buckets :: buckets(K, V)
).
:- type buckets(K, V) == version_array(hash_table_alist(K, V)).
@@ -282,7 +287,7 @@ init_2(HashPred, N, MaxOccupancy, NeedSafety) = HT :-
NeedSafety = no,
Buckets = version_array.unsafe_new(NumBuckets, ht_nil)
),
- HT = ht(0, MaxOccupants, HashPred, Buckets)
+ HT = ht_outer(ht(0, MaxOccupants, HashPred, Buckets))
).
%-----------------------------------------------------------------------------%
@@ -297,7 +302,9 @@ unsafe_new_default(HashPred) = unsafe_init(HashPred, 7, 0.9).
%-----------------------------------------------------------------------------%
-num_buckets(HT) = size(HT ^ buckets).
+num_buckets(HT) = size(inner(HT) ^ ht_buckets).
+
+num_occupants(HT) = inner(HT) ^ ht_num_occupants.
%-----------------------------------------------------------------------------%
@@ -305,7 +312,7 @@ num_buckets(HT) = size(HT ^ buckets).
:- pragma inline(find_slot/2).
find_slot(HT, K) = H :-
- unsafe_hash_pred_cast(HT ^ hash_pred, HashPred),
+ unsafe_hash_pred_cast(inner(HT) ^ ht_hash_pred, HashPred),
find_slot_2(HashPred, K, HT ^ num_buckets, H).
:- pred find_slot_2(hash_pred(K)::in(hash_pred), K::in, int::in, int::out)
@@ -344,15 +351,15 @@ find_slot_2(HashPred, K, NumBuckets, H) :-
%-----------------------------------------------------------------------------%
copy(HT0) = HT :-
- HT0 = ht(NumOccupants, MaxOccupants, HashPred, Buckets0),
+ inner(HT0) = ht(NumOccupants, MaxOccupants, HashPred, Buckets0),
copy(Buckets0, Buckets),
- HT = ht(NumOccupants, MaxOccupants, HashPred, Buckets).
+ HT = ht_outer(ht(NumOccupants, MaxOccupants, HashPred, Buckets)).
%-----------------------------------------------------------------------------%
set(HT0, K, V) = HT :-
H = find_slot(HT0, K),
- HT0 = ht(NumOccupants0, MaxOccupants, HashPred, Buckets0),
+ inner(HT0) = ht(NumOccupants0, MaxOccupants, HashPred, Buckets0),
AL0 = Buckets0 ^ elem(H),
(
AL0 = ht_nil,
@@ -380,14 +387,14 @@ set(HT0, K, V) = HT :-
Buckets = Buckets0 ^ elem(H) := AL,
(
MayExpand = no,
- HT = ht(NumOccupants0, MaxOccupants, HashPred, Buckets)
+ HT = ht_outer(ht(NumOccupants0, MaxOccupants, HashPred, Buckets))
;
MayExpand = yes,
NumOccupants = NumOccupants0 + 1,
( NumOccupants > MaxOccupants ->
HT = expand(NumOccupants, MaxOccupants, HashPred, Buckets)
;
- HT = ht(NumOccupants, MaxOccupants, HashPred, Buckets)
+ HT = ht_outer(ht(NumOccupants, MaxOccupants, HashPred, Buckets))
)
).
@@ -422,7 +429,7 @@ search(HT, K, search(HT, K)).
search(HT, K) = V :-
H = find_slot(HT, K),
- AL = HT ^ buckets ^ elem(H),
+ AL = inner(HT) ^ ht_buckets ^ elem(H),
alist_search(AL, K, V).
:- pred alist_search(hash_table_alist(K, V)::in, K::in, V::out) is semidet.
@@ -447,7 +454,7 @@ alist_search(AL, K, V) :-
det_insert(HT0, K, V) = HT :-
H = find_slot(HT0, K),
- HT0 = ht(NumOccupants0, MaxOccupants, HashPred, Buckets0),
+ inner(HT0) = ht(NumOccupants0, MaxOccupants, HashPred, Buckets0),
AL0 = Buckets0 ^ elem(H),
(
AL0 = ht_nil,
@@ -468,7 +475,7 @@ det_insert(HT0, K, V) = HT :-
( NumOccupants > MaxOccupants ->
HT = expand(NumOccupants, MaxOccupants, HashPred, Buckets)
;
- HT = ht(NumOccupants, MaxOccupants, HashPred, Buckets)
+ HT = ht_outer(ht(NumOccupants, MaxOccupants, HashPred, Buckets))
).
det_insert(K, V, HT, det_insert(HT, K, V)).
@@ -477,13 +484,15 @@ det_insert(K, V, HT, det_insert(HT, K, V)).
det_update(HT0, K, V) = HT :-
H = find_slot(HT0, K),
- AL0 = HT0 ^ buckets ^ elem(H),
+ HTIn0 = inner(HT0),
+ AL0 = HTIn0 ^ ht_buckets ^ elem(H),
( if alist_replace(AL0, K, V, AL1) then
AL = AL1
else
throw(software_error("version_hash_table.det_update: key not found"))
),
- HT = HT0 ^ buckets ^ elem(H) := AL.
+ HTIn = HTIn0 ^ ht_buckets ^ elem(H) := AL,
+ HT = ht_outer(HTIn).
det_update(K, V, HT, det_update(HT, K, V)).
@@ -501,12 +510,12 @@ elem(K, HT) = lookup(HT, K).
delete(HT0, K) = HT :-
H = find_slot(HT0, K),
- AL0 = HT0 ^ buckets ^ elem(H),
+ AL0 = inner(HT0) ^ ht_buckets ^ elem(H),
( if alist_remove(AL0, K, AL) then
- HT0 = ht(NumOccupants0, MaxOccupants, HashPred, Buckets0),
+ inner(HT0) = ht(NumOccupants0, MaxOccupants, HashPred, Buckets0),
Buckets = Buckets0 ^ elem(H) := AL,
NumOccupants = NumOccupants0 - 1,
- HT = ht(NumOccupants, MaxOccupants, HashPred, Buckets)
+ HT = ht_outer(ht(NumOccupants, MaxOccupants, HashPred, Buckets))
else
HT = HT0
).
@@ -538,7 +547,7 @@ alist_remove(AL0, K, AL) :-
%-----------------------------------------------------------------------------%
to_assoc_list(HT) = AL :-
- foldl(to_assoc_list_2, HT ^ buckets, [], AL).
+ foldl(to_assoc_list_2, inner(HT) ^ ht_buckets, [], AL).
:- pred to_assoc_list_2(hash_table_alist(K, V)::in,
assoc_list(K, V)::in, assoc_list(K, V)::out) is det.
@@ -594,7 +603,7 @@ expand(NumOccupants, MaxOccupants0, HashPred0, Buckets0) = HT :-
unsafe_hash_pred_cast(HashPred0, HashPred),
Buckets1 = version_array.init(NumBuckets, ht_nil),
reinsert_bindings(0, Buckets0, HashPred, NumBuckets, Buckets1, Buckets),
- HT = ht(NumOccupants, MaxOccupants, HashPred, Buckets).
+ HT = ht_outer(ht(NumOccupants, MaxOccupants, HashPred, Buckets)).
:- pred reinsert_bindings(int::in, buckets(K, V)::in,
hash_pred(K)::in(hash_pred), int::in,
@@ -760,7 +769,7 @@ munge(N, X) =
%-----------------------------------------------------------------------------%
fold(F, HT, X0) = X :-
- foldl(fold_f(F), HT ^ buckets, X0, X).
+ foldl(fold_f(F), inner(HT) ^ ht_buckets, X0, X).
:- pred fold_f(func(K, V, T) = T, hash_table_alist(K, V), T, T).
:- mode fold_f(func(in, in, in) = out is det, in, in, out) is det.
@@ -780,7 +789,7 @@ fold_f(F, List, A0, A) :-
).
fold(P, HT, !A) :-
- foldl(fold_p(P), HT ^ buckets, !A).
+ foldl(fold_p(P), inner(HT) ^ ht_buckets, !A).
:- pred fold_p(pred(K, V, T, T), hash_table_alist(K, V), T, T).
:- mode fold_p(pred(in, in, in, out) is det, in, in, out) is det.
@@ -803,5 +812,74 @@ fold_p(P, List, !A) :-
).
%-----------------------------------------------------------------------------%
+
+:- pred version_hash_table_equals(version_hash_table(K, V)::in,
+ version_hash_table(K, V)::in) is semidet.
+% This pragma is required becase termination analysis can't analyse the use
+% of higher order code.
+:- pragma terminates(version_hash_table_equals/2).
+
+version_hash_table_equals(A, B) :-
+ promise_pure
+ ( semipure pointer_equals(A, B) ->
+ true
+ ;
+ inner(A) ^ ht_num_occupants = inner(B) ^ ht_num_occupants,
+ % XXX: Max occupants is allowed to differ and hash pred may not be
+ % compared.
+ fold(compare_item(B), A, unit, _)
+ ).
+
+:- pred compare_item(version_hash_table(K, V)::in, K::in, V::in,
+ unit::in, unit::out) is semidet.
+
+compare_item(Table, K, V, unit, unit) :-
+ search(Table, K, V).
+
+ % We create inner (and the extra level of types) in order to make user
+ % defined equality easier to support.
+ %
+:- pred inner(version_hash_table(K, V)::in, ht_inner(K, V)::out) is det.
+
+inner(Outer, Inner) :-
+ promise_equivalent_solutions [Inner]
+ Outer = ht_outer(Inner).
+
+:- func inner(version_hash_table(K, V)) = ht_inner(K, V).
+:- pragma inline(inner/1).
+
+inner(Outer) = Inner :-
+ inner(Outer, Inner).
+
+:- semipure pred pointer_equals(T::in, T::in) is semidet.
+:- pragma inline(pointer_equals/2).
+
+:- pragma foreign_proc("C", pointer_equals(A::in, B::in),
+ [promise_semipure, thread_safe, will_not_call_mercury,
+ will_not_throw_exception, terminates],
+ "
+ SUCCESS_INDICATOR = A == B;
+ ").
+
+:- pragma foreign_proc("Java", pointer_equals(A::in, B::in),
+ [promise_semipure, thread_safe, will_not_call_mercury,
+ will_not_throw_exception, terminates],
+ "
+ SUCCESS_INDICATOR = A == B;
+ ").
+
+:- pragma foreign_proc("C#", pointer_equals(A::in, B::in),
+ [promise_semipure, thread_safe, will_not_call_mercury,
+ will_not_throw_exception, terminates],
+ "
+ SUCCESS_INDICATOR = System.Object.ReferenceEquals(A, B);
+ ").
+
+% Conservative default if a backend does not have pointer equality, such as
+% Erlang. (Erlang does have erts_debug:same/1 but I don't know if we can
+% rely on that.)
+pointer_equals(A, B) :- false.
+
+%-----------------------------------------------------------------------------%
:- end_module version_hash_table.
%-----------------------------------------------------------------------------%
--
1.8.1.3
More information about the reviews
mailing list