summaryrefslogtreecommitdiff
path: root/module/rnrs/hashtables.scm
diff options
context:
space:
mode:
Diffstat (limited to 'module/rnrs/hashtables.scm')
-rw-r--r--module/rnrs/hashtables.scm22
1 files changed, 15 insertions, 7 deletions
diff --git a/module/rnrs/hashtables.scm b/module/rnrs/hashtables.scm
index 5773eb1a8..22bae7f09 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)))))