bug#56199: hash table equality predicate [PATCH]

bug#56199: hash table equality predicate [PATCH]

[Mattias Engdegård]

[-- Attachment #1: Type: text/plain, Size: 600 bytes --]

Recently[1] a predicate for structural equality was requested that also recurses through hash tables.
It showed that Emacs doesn't even come with a way of comparing hash tables. Third-party implementations exist but if the code quoted in [2] is representative, perhaps it would make sense to add a `hash-table-equal-p` predicate?
Even implemented entirely in Lisp it would be an order of magnitude faster (and actually correct).

The attached code is not without flaws but provides a rough starting point.
(This is not meant as a strong argument for or against adding it in the first place.)


[-- Attachment #2: hash-table-equal-p.diff --]
[-- Type: application/octet-stream, Size: 3636 bytes --]

diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 9cd793d05c..17ca80a297 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -93,6 +93,28 @@ hash-table-values
   "Return a list of values in HASH-TABLE."
   (cl-loop for v being the hash-values of hash-table collect v))
 
+(defun hash-table-equal-p (h1 h2 &optional value-eq)
+  "Whether the hash tables H1 and H2 are equal with respect to VALUE-EQ.
+Equality means that the tables have the same equality predicate
+and the same set of key-value pairs where keys are compared by
+that predicate and values by VALUE-EQ, which defaults to `eq'."
+  (or (eq h1 h2)
+      (and (= (hash-table-count h1) (hash-table-count h2))
+           (eq (hash-table-test h1) (hash-table-test h2))
+           (progn
+             (unless value-eq
+               (setq value-eq #'eq))
+             ;; Loop over the physically smaller table.
+             (when (> (hash-table-size h1) (hash-table-size h2))
+               (cl-rotatef h1 h2))
+             (catch 'done
+               (maphash
+                (lambda (k v)
+                  (unless (funcall value-eq v (gethash k h2 (not v)))
+                    (throw 'done nil)))
+                h1)
+               t)))))
+
 (defsubst string-empty-p (string)
   "Check whether STRING is empty."
   (string= string ""))
diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el
index 7f3916c2c0..923155eedb 100644
--- a/test/lisp/emacs-lisp/subr-x-tests.el
+++ b/test/lisp/emacs-lisp/subr-x-tests.el
@@ -743,6 +743,55 @@ test-with-buffer-unmodified-if-unchanged
           (with-current-buffer inner
             (should-not (buffer-modified-p))))))))
 
+(ert-deftest subr-x--hash-table-equal-p ()
+  (cl-flet ((hashtab (test &rest elts)
+              (let ((h (make-hash-table :test test)))
+                (while elts
+                  (let* ((key (pop elts))
+                         (val (pop elts)))
+                    (puthash key val h)))
+                h)))
+
+    (let ((h1 (hashtab #'eq 'a (list 1) 'b (list 2))
+          (h2 (hashtab #'eq 'a (list 1) 'b (list 2)))))
+      (should (hash-table-equal-p h1 h2 #'equal))
+      (should (hash-table-equal-p h2 h1 #'equal))
+      (should (not (hash-table-equal-p h1 h2 #'eq)))
+      (should (not (hash-table-equal-p h2 h1 #'eq)))
+      (should (hash-table-equal-p h1 h1 #'eq)))
+
+    (let ((h1 (hashtab #'eql 1 'a 2 'b)
+          (h2 (hashtab #'equal 1 'a 2 'b))))
+      (should (not (hash-table-equal-p h1 h2)))
+      (should (not (hash-table-equal-p h2 h1))))
+
+    (let ((h1 (hashtab #'eql 1 'a 2 'a)
+          (h2 (hashtab #'eql 1 'a))))
+      (should (not (hash-table-equal-p h1 h2)))
+      (should (not (hash-table-equal-p h2 h1))))
+
+    (let ((h1 (hashtab #'eql 1 'a 2 'a)
+          (h2 (hashtab #'eql 1 'a 2 'b))))
+      (should (not (hash-table-equal-p h1 h2)))
+      (should (not (hash-table-equal-p h2 h1))))
+
+    (let ((h1 (hashtab #'eql 1 'a 2 'a)
+          (h2 (hashtab #'eql 1 'a 3 'a))))
+      (should (not (hash-table-equal-p h1 h2)))
+      (should (not (hash-table-equal-p h2 h1))))
+
+    (let ((h1 (hashtab #'eql)
+          (h2 (hashtab #'eql))))
+      (should (hash-table-equal-p h1 h2))
+      (should (hash-table-equal-p h2 h1)))
+
+    (let ((h1 (make-hash-table :test #'eql :size 1000 :rehash-size 3.5))
+          (h2 (hashtab #'eql 10 'a 20 'b)))
+      (puthash 10 'a h1)
+      (puthash 20 'b h1)
+      (should (hash-table-equal-p h1 h2))
+      (should (hash-table-equal-p h2 h1)))
+    ))
 
 (provide 'subr-x-tests)
 ;;; subr-x-tests.el ends here

[-- Attachment #3: Type: text/plain, Size: 153 bytes --]



--

[1] https://lists.gnu.org/archive/html/emacs-devel/2022-06/msg00444.html
[2] https://lists.gnu.org/archive/html/emacs-devel/2022-06/msg00553.html

bug#56199: hash table equality predicate [PATCH]

[Lars Ingebrigtsen]

Mattias Engdegård <mattiase@acm.org> writes:

> Even implemented entirely in Lisp it would be an order of magnitude
> faster (and actually correct).
>
> The attached code is not without flaws but provides a rough starting point.
> (This is not meant as a strong argument for or against adding it in
> the first place.)

I can't ever recall wanting to compare two hash tables for equality
(like, that's not what you use a hash table for), but since people have
apparently been reimplementing this a lot, then I'm for including it.

And the implementation looks nice.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#56199: hash table equality predicate [PATCH]

[Mattias Engdegård]

24 juni 2022 kl. 20.21 skrev Lars Ingebrigtsen <larsi@gnus.org>:

> I can't ever recall wanting to compare two hash tables for equality
> (like, that's not what you use a hash table for)

No, you're right -- it's better to wait until there is a concrete need for it.

bug#56199: hash table equality predicate [PATCH]

[Jean Louis]

I use database stored hashes where new edited and updated one shall be compared to the stored one.

This will become useful.


Jean