From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: taylanbayirli@gmail.com (Taylan Ulrich =?UTF-8?Q?Bay=C4=B1rl=C4=B1/Kammer?=) Newsgroups: gmane.lisp.guile.bugs Subject: bug#22446: (rnrs hashtables): Hash functions of eq? and eqv? hashtables Date: Tue, 21 Jun 2016 00:34:45 +0200 Message-ID: <871t3rqyka.fsf@T420.taylan> References: <871t98knd4.fsf@T420.taylan> <87d1srjj2b.fsf_-_@T420.taylan> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1466462128 7612 80.91.229.3 (20 Jun 2016 22:35:28 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Mon, 20 Jun 2016 22:35:28 +0000 (UTC) To: 22446@debbugs.gnu.org Original-X-From: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Tue Jun 21 00:35:19 2016 Return-path: Envelope-to: guile-bugs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1bF7mm-0007f9-Q7 for guile-bugs@m.gmane.org; Tue, 21 Jun 2016 00:35:17 +0200 Original-Received: from localhost ([::1]:46899 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bF7mm-0006vm-2u for guile-bugs@m.gmane.org; Mon, 20 Jun 2016 18:35:16 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:49598) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bF7md-0006mP-Fm for bug-guile@gnu.org; Mon, 20 Jun 2016 18:35:08 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1bF7mY-00061o-Eg for bug-guile@gnu.org; Mon, 20 Jun 2016 18:35:06 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:35807) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bF7mY-00061k-Ad for bug-guile@gnu.org; Mon, 20 Jun 2016 18:35:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1bF7mY-0005Pg-5d for bug-guile@gnu.org; Mon, 20 Jun 2016 18:35:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: taylanbayirli@gmail.com (Taylan Ulrich =?UTF-8?Q?Bay=C4=B1rl=C4=B1/Kammer?=) Original-Sender: "Debbugs-submit" Resent-CC: bug-guile@gnu.org Resent-Date: Mon, 20 Jun 2016 22:35:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 22446 X-GNU-PR-Package: guile X-GNU-PR-Keywords: Original-Received: via spool by 22446-submit@debbugs.gnu.org id=B22446.146646209420790 (code B ref 22446); Mon, 20 Jun 2016 22:35:02 +0000 Original-Received: (at 22446) by debbugs.gnu.org; 20 Jun 2016 22:34:54 +0000 Original-Received: from localhost ([127.0.0.1]:48144 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1bF7mQ-0005PG-Dm for submit@debbugs.gnu.org; Mon, 20 Jun 2016 18:34:54 -0400 Original-Received: from mail-lb0-f172.google.com ([209.85.217.172]:34705) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1bF7mO-0005P3-S9 for 22446@debbugs.gnu.org; Mon, 20 Jun 2016 18:34:53 -0400 Original-Received: by mail-lb0-f172.google.com with SMTP id oe3so2277946lbb.1 for <22446@debbugs.gnu.org>; Mon, 20 Jun 2016 15:34:52 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=gIgYoIKtiiqvo0dit1n96VWFSk9xPH27CvbAklNxlAs=; b=b/kMYk1UqjGqQxeAT1RE8Jc7SuqAcnuRgratyB13QTKVpiXQaJu5ZFLE8oV7VTpriT UtYENO5c3iETTWe7T081uUdDmVEfTY63PYVyarHhD7I5hFLtkbk99qlYBrBpSCkMbZdI vs9c/gs06uL42Lpr0y1VYy+j8pN9Do28jlsfloPI5IEIdvjDKaNeZEV7YX8f34pPPU/z RRoRpOlh3VKLsydGBvDNNXHi9T9y4YiijhBJXCzi4YL1pwD1wfJxLQah8HP/lxeFs36I YET8J/Pfqb/Utqrt77SOkhuBNOgbWk+ciXRKOyUxlzejjZq7+RqA5/xjNugxRXvhyQeT n51Q== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20130820; h=x-gm-message-state:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version; bh=gIgYoIKtiiqvo0dit1n96VWFSk9xPH27CvbAklNxlAs=; b=HU9y5HPrtKCkx8IrFkkdT7x04zaQCn6AFbgLtpATLSZ9PAJKFm8p3z5nVmuVZvLNtk JvMNw8TvhbvBwNf2u3wB2t5ISWyWgapmLZHHBfap7NJ7x3vCsX9tlhNsyzhzLei1xGmx npbU/vDpalh2RItmS3LhVeLS3Tl9mc9FWk1F27jId6dJCNmNZl0GuTaZn+2Tz35LM/FZ ccUqGe6A40bpxYEvRZhE9MCRSlEHvAWYMpCVNj1Bn2xSAdy0TgkPOXKRT9HvIPI55x4F bhWUtSSoW8t667NMVyA/3dcYM2Uc/OskdTrYzZ37EUd/EnPCNP4ADhpwb0QXIwCo2Ht5 Gw7g== X-Gm-Message-State: ALyK8tI6E5YU8+HV9GvjCMGKeZZ/1573ZZSytawzL2d4Nms0lHtUb/mzMK1l/mzafvwwyg== X-Received: by 10.194.238.234 with SMTP id vn10mr16297680wjc.127.1466462087046; Mon, 20 Jun 2016 15:34:47 -0700 (PDT) Original-Received: from T420.taylan ([2a02:908:c30:3540:221:ccff:fe66:68f0]) by smtp.gmail.com with ESMTPSA id ze10sm13694997wjb.2.2016.06.20.15.34.45 (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Mon, 20 Jun 2016 15:34:46 -0700 (PDT) In-Reply-To: <87d1srjj2b.fsf_-_@T420.taylan> ("Taylan Ulrich \=\?utf-8\?Q\?\=5C\=22Bay\=C4\=B1rl\=C4\=B1\=2FKammer\=5C\=22\=22's\?\= message of "Sun, 24 Jan 2016 12:47:08 +0100") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.5 (gnu/linux) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-guile@gnu.org List-Id: "Bug reports for GUILE, GNU's Ubiquitous Extension Language" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Original-Sender: "bug-guile" Xref: news.gmane.org gmane.lisp.guile.bugs:8049 Archived-At: --=-=-= Content-Type: text/plain Also pinging this thread with a (very slightly) updated patch. :-) --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-Hashtable-hash-function-returns-f-on-eq-and-eqv-tabl.patch >From 17599f6ce7ba0beb100e80455ff99af07333d871 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Taylan=20Ulrich=20Bay=C4=B1rl=C4=B1/Kammer?= Date: Tue, 21 Jun 2016 00:23:29 +0200 Subject: [PATCH] Hashtable-hash-function returns #f on eq and eqv tables. * module/rnrs/hashtables.scm (r6rs:hashtable)[type]: New field. (r6rs:hashtable-type): New procedure. * test-suite/tests/r6rs-hashtables.test: Add related tests. --- module/rnrs/hashtables.scm | 22 +++++++++++++++------- test-suite/tests/r6rs-hashtables.test | 6 +++++- 2 files changed, 20 insertions(+), 8 deletions(-) diff --git a/module/rnrs/hashtables.scm b/module/rnrs/hashtables.scm index 98d2d76..08f37e2 100644 --- a/module/rnrs/hashtables.scm +++ b/module/rnrs/hashtables.scm @@ -74,8 +74,9 @@ (make-record-type-descriptor 'r6rs:hashtable #f #f #t #t '#((mutable wrapped-table) - (immutable orig-hash-function) - (immutable mutable)))) + (immutable orig-hash-function) + (immutable mutable) + (immutable type)))) (define hashtable? (record-predicate r6rs:hashtable)) (define make-r6rs-hashtable @@ -85,6 +86,7 @@ (define r6rs:hashtable-set-wrapped-table! (record-mutator r6rs:hashtable 0)) (define r6rs:hashtable-orig-hash-function (record-accessor r6rs:hashtable 1)) (define r6rs:hashtable-mutable? (record-accessor r6rs:hashtable 2)) + (define r6rs:hashtable-type (record-accessor r6rs:hashtable 3)) (define hashtable-mutable? r6rs:hashtable-mutable?) @@ -96,13 +98,15 @@ (make-r6rs-hashtable (if k (make-hash-table eq? hashq k) (make-hash-table eq? symbol-hash)) symbol-hash - #t)) + #t + 'eq)) (define* (make-eqv-hashtable #:optional k) (make-r6rs-hashtable (if k (make-hash-table eqv? hashv k) (make-hash-table eqv? hash-by-value)) hash-by-value - #t)) + #t + 'eqv)) (define* (make-hashtable hash-function equiv #:optional k) (let ((wrapped-hash-function (wrap-hash-function hash-function))) @@ -111,7 +115,8 @@ (make-hash-table equiv wrapped-hash-function k) (make-hash-table equiv wrapped-hash-function)) hash-function - #t))) + #t + 'custom))) (define (hashtable-size hashtable) (hash-table-size (r6rs:hashtable-wrapped-table hashtable))) @@ -143,7 +148,8 @@ (make-r6rs-hashtable (hash-table-copy (r6rs:hashtable-wrapped-table hashtable)) (r6rs:hashtable-orig-hash-function hashtable) - (and mutable #t))) + (and mutable #t) + (r6rs:hashtable-type hashtable))) (define* (hashtable-clear! hashtable #:optional k) (if (r6rs:hashtable-mutable? hashtable) @@ -178,4 +184,6 @@ (hash-table-equivalence-function (r6rs:hashtable-wrapped-table hashtable))) (define (hashtable-hash-function hashtable) - (r6rs:hashtable-orig-hash-function hashtable))) + (case (r6rs:hashtable-type hashtable) + ((eq eqv) #f) + (else (r6rs:hashtable-orig-hash-function hashtable))))) diff --git a/test-suite/tests/r6rs-hashtables.test b/test-suite/tests/r6rs-hashtables.test index c7812c5..fbc50c9 100644 --- a/test-suite/tests/r6rs-hashtables.test +++ b/test-suite/tests/r6rs-hashtables.test @@ -174,7 +174,11 @@ (with-test-prefix "hashtable-hash-function" (pass-if "hashtable-hash-function returns hash function" (let ((abs-hashtable (make-hashtable abs eqv?))) - (eq? (hashtable-hash-function abs-hashtable) abs)))) + (eq? (hashtable-hash-function abs-hashtable) abs))) + (pass-if "hashtable-hash-function returns #f on eq table" + (eq? #f (hashtable-hash-function (make-eq-hashtable)))) + (pass-if "hashtable-hash-function returns #f on eqv table" + (eq? #f (hashtable-hash-function (make-eqv-hashtable))))) (with-test-prefix "hashtable-mutable?" (pass-if "hashtable-mutable? is #t on mutable hashtables" -- 2.8.4 --=-=-=--