From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Andy Wingo Newsgroups: gmane.lisp.guile.bugs Subject: bug#22446: (rnrs hashtables): Hash functions of eq? and eqv? hashtables Date: Tue, 21 Jun 2016 09:48:46 +0200 Message-ID: <87fus73rtt.fsf@pobox.com> References: <871t98knd4.fsf@T420.taylan> <87d1srjj2b.fsf_-_@T420.taylan> <871t3rqyka.fsf@T420.taylan> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Trace: ger.gmane.org 1466495393 28284 80.91.229.3 (21 Jun 2016 07:49:53 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 21 Jun 2016 07:49:53 +0000 (UTC) Cc: 22446-done@debbugs.gnu.org To: taylanbayirli@gmail.com (Taylan Ulrich "=?UTF-8?Q?Bay=C4=B1rl=C4=B1/Kammer?=") Original-X-From: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Tue Jun 21 09:49:43 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 1bFGRK-0003LZ-MA for guile-bugs@m.gmane.org; Tue, 21 Jun 2016 09:49:42 +0200 Original-Received: from localhost ([::1]:49458 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bFGRJ-0004SA-Je for guile-bugs@m.gmane.org; Tue, 21 Jun 2016 03:49:41 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:60942) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bFGQl-00044g-Cp for bug-guile@gnu.org; Tue, 21 Jun 2016 03:49:08 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1bFGQh-0003RF-8f for bug-guile@gnu.org; Tue, 21 Jun 2016 03:49:06 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:36157) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bFGQh-0003Qy-2n for bug-guile@gnu.org; Tue, 21 Jun 2016 03:49:03 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1bFGQg-0001cW-Vt for bug-guile@gnu.org; Tue, 21 Jun 2016 03:49:02 -0400 Resent-From: Andy Wingo Original-Sender: "Debbugs-submit" Resent-To: bug-guile@gnu.org Resent-Date: Tue, 21 Jun 2016 07:49:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: cc-closed 22446 X-GNU-PR-Package: guile X-GNU-PR-Keywords: Mail-Followup-To: 22446@debbugs.gnu.org, wingo@pobox.com, taylanbayirli@gmail.com Original-Received: via spool by 22446-done@debbugs.gnu.org id=D22446.14664953366203 (code D ref 22446); Tue, 21 Jun 2016 07:49:02 +0000 Original-Received: (at 22446-done) by debbugs.gnu.org; 21 Jun 2016 07:48:56 +0000 Original-Received: from localhost ([127.0.0.1]:48491 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1bFGQa-0001bz-GX for submit@debbugs.gnu.org; Tue, 21 Jun 2016 03:48:56 -0400 Original-Received: from pb-sasl1.pobox.com ([64.147.108.66]:52612 helo=sasl.smtp.pobox.com) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1bFGQY-0001br-Nb for 22446-done@debbugs.gnu.org; Tue, 21 Jun 2016 03:48:55 -0400 Original-Received: from sasl.smtp.pobox.com (unknown [127.0.0.1]) by pb-sasl1.pobox.com (Postfix) with ESMTP id 8081B1FFE3; Tue, 21 Jun 2016 03:48:54 -0400 (EDT) DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=pobox.com; h=from:to:cc :subject:references:date:in-reply-to:message-id:mime-version :content-type:content-transfer-encoding; s=sasl; bh=6WkAnXMpW9UE NQA3pKP8zwN/dc8=; b=WZpX+F3LwfyJu0Zxu94ii/LAn8q/sMm2rGWiwLKa85nL cgZKd9WUlfRPa6j1RsNy8JxJ/LkfSgZfPL2iygUVl1x/Vc354pUyzGmS/m1GPWOD EFRsAlk7x4p18Wo2iQ8KfROqN8YI5+GrI/o54F3kKcZtGXinDZmcc9xIWhVRCBE= DomainKey-Signature: a=rsa-sha1; c=nofws; d=pobox.com; h=from:to:cc :subject:references:date:in-reply-to:message-id:mime-version :content-type:content-transfer-encoding; q=dns; s=sasl; b=eUFiJ0 R1bSg7qJEm9oSLPKnzU7mdQRbkM1fCl6SnsmpEZ4g73KVlaju+DDzFalk1jO5hrG ULzP7rqs0nH4cZYA34P6pVUlw25aDVsukQMUQPdLGyrysvTPkwYbeRr91IvP2glx 1OBf7ENqBNK38CB2ifowfWKWAiWH0wrYtYPBk= Original-Received: from pb-sasl1.nyi.icgroup.com (unknown [127.0.0.1]) by pb-sasl1.pobox.com (Postfix) with ESMTP id 79CED1FFE2; Tue, 21 Jun 2016 03:48:54 -0400 (EDT) Original-Received: from clucks (unknown [88.160.190.192]) (using TLSv1 with cipher ECDHE-RSA-AES256-SHA (256/256 bits)) (No client certificate requested) by pb-sasl1.pobox.com (Postfix) with ESMTPSA id 8F5861FFDF; Tue, 21 Jun 2016 03:48:53 -0400 (EDT) In-Reply-To: <871t3rqyka.fsf@T420.taylan> ("Taylan Ulrich \"=?UTF-8?Q?Bay=C4=B1rl=C4=B1/Kammer\?=""'s message of "Tue, 21 Jun 2016 00:34:45 +0200") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.5 (gnu/linux) X-Pobox-Relay-ID: 99E3F098-3784-11E6-8005-C1836462E9F6-02397024!pb-sasl1.pobox.com 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:8061 Archived-At: Applied, thanks :) On Tue 21 Jun 2016 00:34, taylanbayirli@gmail.com (Taylan Ulrich "Bay=C4=B1= rl=C4=B1/Kammer") writes: > Also pinging this thread with a (very slightly) updated patch. :-) > > > From 17599f6ce7ba0beb100e80455ff99af07333d871 Mon Sep 17 00:00:00 2001 > From: =3D?UTF-8?q?Taylan=3D20Ulrich=3D20Bay=3DC4=3DB1rl=3DC4=3DB1/Kammer?= =3D > > 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=20 > 'r6rs:hashtable #f #f #t #t=20 > '#((mutable wrapped-table) > - (immutable orig-hash-function) > - (immutable mutable)))) > + (immutable orig-hash-function) > + (immutable mutable) > + (immutable type)))) >=20=20 > (define hashtable? (record-predicate r6rs:hashtable)) > (define make-r6rs-hashtable=20 > @@ -85,6 +86,7 @@ > (define r6rs:hashtable-set-wrapped-table! (record-mutator r6rs:hashtab= le 0)) > (define r6rs:hashtable-orig-hash-function (record-accessor r6rs:hashta= ble 1)) > (define r6rs:hashtable-mutable? (record-accessor r6rs:hashtable 2)) > + (define r6rs:hashtable-type (record-accessor r6rs:hashtable 3)) >=20=20 > (define hashtable-mutable? r6rs:hashtable-mutable?) >=20=20 > @@ -96,13 +98,15 @@ > (make-r6rs-hashtable=20 > (if k (make-hash-table eq? hashq k) (make-hash-table eq? symbol-has= h)) > symbol-hash > - #t)) > + #t > + 'eq)) >=20=20 > (define* (make-eqv-hashtable #:optional k) > (make-r6rs-hashtable=20 > (if k (make-hash-table eqv? hashv k) (make-hash-table eqv? hash-by-= value)) > hash-by-value > - #t)) > + #t > + 'eqv)) >=20=20 > (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))) >=20=20=20 > (define (hashtable-size hashtable) > (hash-table-size (r6rs:hashtable-wrapped-table hashtable))) > @@ -143,7 +148,8 @@ > (make-r6rs-hashtable=20 > (hash-table-copy (r6rs:hashtable-wrapped-table hashtable)) > (r6rs:hashtable-orig-hash-function hashtable) > - (and mutable #t))) > + (and mutable #t) > + (r6rs:hashtable-type hashtable))) >=20=20 > (define* (hashtable-clear! hashtable #:optional k) > (if (r6rs:hashtable-mutable? hashtable) > @@ -178,4 +184,6 @@ > (hash-table-equivalence-function (r6rs:hashtable-wrapped-table hasht= able))) >=20=20 > (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/r6r= s-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))))) >=20=20 > (with-test-prefix "hashtable-mutable?" > (pass-if "hashtable-mutable? is #t on mutable hashtables"