ble hashtable) key default)) (define (hashtable-set! hashtable key obj) (if (r6rs:hashtable-mutable? hashtable) (hash-table-set! (r6rs:hashtable-wrapped-table hashtable) key obj) (assertion-violation 'hashtable-set! "Hashtable is immutable." hashtable))) (define (hashtable-delete! hashtable key) (if (r6rs:hashtable-mutable? hashtable) (hash-table-delete! (r6rs:hashtable-wrapped-table hashtable) key)) *unspecified*) (define (hashtable-contains? hashtable key) (hash-table-exists? (r6rs:hashtable-wrapped-table hashtable) key)) (define (hashtable-update! hashtable key proc default) (if (r6rs:hashtable-mutable? hashtable) (hash-table-update!/default (r6rs:hashtable-wrapped-table hashtable) key proc default)) *unspecified*) (define* (hashtable-copy hashtable #:optional mutable) (make-r6rs-hashtable (hash-table-copy (r6rs:hashtable-wrapped-table hashtable)) (r6rs:hashtable-orig-hash-function hashtable) (and mutable #t) (r6rs:hashtable-type hashtable))) (define* (hashtable-clear! hashtable #:optional k) (if (r6rs:hashtable-mutable? hashtable) (let* ((ht (r6rs:hashtable-wrapped-table hashtable)) (equiv (hash-table-equivalence-function ht)) (hash-function (r6rs:hashtable-orig-hash-function hashtable)) (wrapped-hash-function (wrap-hash-function hash-function))) (r6rs:hashtable-set-wrapped-table! hashtable (if k (make-hash-table equiv wrapped-hash-function k) (make-hash-table equiv wrapped-hash-function))))) *unspecified*) (define (hashtable-keys hashtable) (list->vector (hash-table-keys (r6rs:hashtable-wrapped-table hashtable)))) (define (hashtable-entries hashtable) (let* ((ht (r6rs:hashtable-wrapped-table hashtable)) (size (hash-table-size ht)) (keys (make-vector size)) (vals (make-vector size))) (hash-table-fold (r6rs:hashtable-wrapped-table hashtable) (lambda (k v i) (vector-set! keys i k) (vector-set! vals i v) (+ i 1)) 0) (values keys vals))) (define (hashtable-equivalence-function hashtable) (hash-table-equivalence-function (r6rs:hashtable-wrapped-table hashtable))) (define (hashtable-hash-function hashtable) (case (r6rs:hashtable-type hashtable) ((eq eqv) #f) (else (r6rs:hashtable-orig-hash-function hashtable)))))