--- Begin Message ---
|
Subject: |
(rnrs hashtables): Hash functions of eq? and eqv? hashtables |
|
Date: |
Sat, 23 Jan 2016 22:16:39 +0100 |
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
--- End Message ---
--- Begin Message ---
|
Subject: |
Re: (rnrs hashtables): Hash functions of eq? and eqv? hashtables |
|
Date: |
Tue, 21 Jun 2016 09:48:46 +0200 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/24.5 (gnu/linux) |
Applied, thanks :)
On Tue 21 Jun 2016 00:34, address@hidden (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?=
> <address@hidden>
> 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"
--- End Message ---