* bug#22446: (rnrs hashtables): Hash functions of eq? and eqv? hashtables
@ 2016-01-23 21:16 "Taylan Ulrich Bayırlı/Kammer"
[not found] ` <handler.22446.B.145358354028626.ack@debbugs.gnu.org>
0 siblings, 1 reply; 4+ messages in thread
From: "Taylan Ulrich Bayırlı/Kammer" @ 2016-01-23 21:16 UTC (permalink / raw)
To: 22446
Per R6RS, the following forms should return #f:
(hashtable-hash-function (make-eq-hashtable))
(hashtable-hash-function (make-eqv-hashtable))
but in Guile they return procedures.
Taylan
^ permalink raw reply [flat|nested] 4+ messages in thread[parent not found: <handler.22446.B.145358354028626.ack@debbugs.gnu.org>]
* bug#22446: (rnrs hashtables): Hash functions of eq? and eqv? hashtables [not found] ` <handler.22446.B.145358354028626.ack@debbugs.gnu.org> @ 2016-01-24 11:47 ` Taylan Ulrich Bayırlı/Kammer 2016-06-20 22:34 ` Taylan Ulrich Bayırlı/Kammer 0 siblings, 1 reply; 4+ messages in thread From: Taylan Ulrich Bayırlı/Kammer @ 2016-01-24 11:47 UTC (permalink / raw) To: 22446 [-- Attachment #1: Type: text/plain, Size: 29 bytes --] Here's a patch to fix this. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-Hashtable-hash-function-returns-f-on-eq-and-eqv-tabl.patch --] [-- Type: text/x-diff, Size: 3822 bytes --] From a3e5a705aaea725fd751111280a27b971d8e45e3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Taylan=20Ulrich=20Bay=C4=B1rl=C4=B1/Kammer?= <taylanbayirli@gmail.com> Date: Sun, 24 Jan 2016 12:23:34 +0100 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. --- 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 5773eb1..22bae7f 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))) @@ -144,7 +149,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) @@ -179,4 +185,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 dbf6859..5c48579 100644 --- a/test-suite/tests/r6rs-hashtables.test +++ b/test-suite/tests/r6rs-hashtables.test @@ -176,7 +176,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 hash function" + (eq? #f (hashtable-hash-function (make-eqv-hashtable))))) (with-test-prefix "hashtable-mutable?" (pass-if "hashtable-mutable? is #t on mutable hashtables" -- 2.6.3 ^ permalink raw reply related [flat|nested] 4+ messages in thread
* bug#22446: (rnrs hashtables): Hash functions of eq? and eqv? hashtables 2016-01-24 11:47 ` Taylan Ulrich Bayırlı/Kammer @ 2016-06-20 22:34 ` Taylan Ulrich Bayırlı/Kammer 2016-06-21 7:48 ` Andy Wingo 0 siblings, 1 reply; 4+ messages in thread From: Taylan Ulrich Bayırlı/Kammer @ 2016-06-20 22:34 UTC (permalink / raw) To: 22446 [-- Attachment #1: Type: text/plain, Size: 68 bytes --] Also pinging this thread with a (very slightly) updated patch. :-) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-Hashtable-hash-function-returns-f-on-eq-and-eqv-tabl.patch --] [-- Type: text/x-diff, Size: 3884 bytes --] From 17599f6ce7ba0beb100e80455ff99af07333d871 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Taylan=20Ulrich=20Bay=C4=B1rl=C4=B1/Kammer?= <taylanbayirli@gmail.com> 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 ^ permalink raw reply related [flat|nested] 4+ messages in thread
* bug#22446: (rnrs hashtables): Hash functions of eq? and eqv? hashtables 2016-06-20 22:34 ` Taylan Ulrich Bayırlı/Kammer @ 2016-06-21 7:48 ` Andy Wingo 0 siblings, 0 replies; 4+ messages in thread From: Andy Wingo @ 2016-06-21 7:48 UTC (permalink / raw) To: Taylan Ulrich "Bayırlı/Kammer"; +Cc: 22446-done Applied, thanks :) On Tue 21 Jun 2016 00:34, taylanbayirli@gmail.com (Taylan Ulrich "Bayırlı/Kammer") writes: > Also pinging this thread with a (very slightly) updated patch. :-) > > > From 17599f6ce7ba0beb100e80455ff99af07333d871 Mon Sep 17 00:00:00 2001 > From: =?UTF-8?q?Taylan=20Ulrich=20Bay=C4=B1rl=C4=B1/Kammer?= > <taylanbayirli@gmail.com> > 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" ^ permalink raw reply [flat|nested] 4+ messages in thread
end of thread, other threads:[~2016-06-21 7:48 UTC | newest]
Thread overview: 4+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2016-01-23 21:16 bug#22446: (rnrs hashtables): Hash functions of eq? and eqv? hashtables "Taylan Ulrich Bayırlı/Kammer"
[not found] ` <handler.22446.B.145358354028626.ack@debbugs.gnu.org>
2016-01-24 11:47 ` Taylan Ulrich Bayırlı/Kammer
2016-06-20 22:34 ` Taylan Ulrich Bayırlı/Kammer
2016-06-21 7:48 ` Andy Wingo
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).