From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Mattias =?UTF-8?Q?Engdeg=C3=A5rd?= Newsgroups: gmane.emacs.bugs Subject: bug#56199: hash table equality predicate [PATCH] Date: Fri, 24 Jun 2022 19:19:54 +0200 Message-ID: <8928CA50-5999-47DD-A002-46B7E9005E62@acm.org> Mime-Version: 1.0 (Mac OS X Mail 14.0 \(3654.120.0.1.13\)) Content-Type: multipart/mixed; boundary="Apple-Mail=_F9224A7E-2BFE-499E-9803-001F81A49C5D" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="39042"; mail-complaints-to="usenet@ciao.gmane.io" To: 56199@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Fri Jun 24 19:28:34 2022 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1o4n6g-000A0p-4a for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 24 Jun 2022 19:28:34 +0200 Original-Received: from localhost ([::1]:58820 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1o4n6d-0008AO-6L for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 24 Jun 2022 13:28:31 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:37892) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1o4mzP-0001Vt-4k for bug-gnu-emacs@gnu.org; Fri, 24 Jun 2022 13:21:07 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:49507) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1o4mzO-0000Uk-RG for bug-gnu-emacs@gnu.org; Fri, 24 Jun 2022 13:21:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1o4mzO-0004NA-Fz for bug-gnu-emacs@gnu.org; Fri, 24 Jun 2022 13:21:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Mattias =?UTF-8?Q?Engdeg=C3=A5rd?= Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 24 Jun 2022 17:21:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 56199 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch X-Debbugs-Original-To: bug-gnu-emacs@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.165609121116728 (code B ref -1); Fri, 24 Jun 2022 17:21:02 +0000 Original-Received: (at submit) by debbugs.gnu.org; 24 Jun 2022 17:20:11 +0000 Original-Received: from localhost ([127.0.0.1]:43404 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1o4myZ-0004Lk-J6 for submit@debbugs.gnu.org; Fri, 24 Jun 2022 13:20:11 -0400 Original-Received: from lists.gnu.org ([209.51.188.17]:57168) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1o4myX-0004LY-MI for submit@debbugs.gnu.org; Fri, 24 Jun 2022 13:20:10 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:37712) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1o4myT-0000zP-Sx for bug-gnu-emacs@gnu.org; Fri, 24 Jun 2022 13:20:07 -0400 Original-Received: from mail75c50.megamailservers.eu ([91.136.10.85]:37050 helo=mail92c50.megamailservers.eu) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1o4myQ-00008w-VP for bug-gnu-emacs@gnu.org; Fri, 24 Jun 2022 13:20:05 -0400 X-Authenticated-User: mattiase@bredband.net DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=megamailservers.eu; s=maildub; t=1656091196; bh=GKCVD2srbJvCxWU1mMWODUL9pCTFCqMsl5UwYvSqH90=; h=From:Subject:Date:To:From; b=AkF3HSW1bwu2bxaXgHk+loit5wzg7d3axEv40F+/EYFmqY1Xn2ZEiGKNR0hGPpTz0 E8HrBGsWf2w4CrH8dzRcjvvqWZEizTxpvfrOmlJVhj9qxsKOFgxZlXCA6wZAklNNk+ 6eJVq4syHaoncYvnSY4fb1N1178xOij3RbXd8eC4= Feedback-ID: mattiase@acm.or Original-Received: from smtpclient.apple (c188-150-171-71.bredband.tele2.se [188.150.171.71]) (authenticated bits=0) by mail92c50.megamailservers.eu (8.14.9/8.13.1) with ESMTP id 25OHJsHo078813 for ; Fri, 24 Jun 2022 17:19:56 +0000 X-Mailer: Apple Mail (2.3654.120.0.1.13) X-CTCH-RefID: str=0001.0A782F26.62B5F23C.002C, ss=1, re=0.000, recu=0.000, reip=0.000, cl=1, cld=1, fgs=0 X-CTCH-VOD: Unknown X-CTCH-Spam: Unknown X-CTCH-Score: 0.000 X-CTCH-Flags: 0 X-CTCH-ScoreCust: 0.000 X-Origin-Country: SE Received-SPF: softfail client-ip=91.136.10.85; envelope-from=mattiase@acm.org; helo=mail92c50.megamailservers.eu X-Spam_score_int: -11 X-Spam_score: -1.2 X-Spam_bar: - X-Spam_report: (-1.2 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, SPF_HELO_NONE=0.001, SPF_SOFTFAIL=0.665, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=no autolearn_force=no X-Spam_action: no action X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:235208 Archived-At: --Apple-Mail=_F9224A7E-2BFE-499E-9803-001F81A49C5D Content-Transfer-Encoding: quoted-printable Content-Type: text/plain; charset=us-ascii 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.) --Apple-Mail=_F9224A7E-2BFE-499E-9803-001F81A49C5D Content-Disposition: attachment; filename=hash-table-equal-p.diff Content-Type: application/octet-stream; x-unix-mode=0644; name="hash-table-equal-p.diff" Content-Transfer-Encoding: 7bit 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 --Apple-Mail=_F9224A7E-2BFE-499E-9803-001F81A49C5D Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset=us-ascii -- [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 --Apple-Mail=_F9224A7E-2BFE-499E-9803-001F81A49C5D--