[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