diff --git a/scheme/ikarus.hash-tables.ss b/scheme/ikarus.hash-tables.ss index 3bf3ec5..5095806 100644 --- a/scheme/ikarus.hash-tables.ss +++ b/scheme/ikarus.hash-tables.ss @@ -18,7 +18,7 @@ (export make-eq-hashtable hashtable-ref hashtable-set! hashtable? hashtable-size hashtable-delete! hashtable-contains? hashtable-update! hashtable-keys hashtable-mutable? - hashtable-clear!) + hashtable-clear! hashtable-entries) (import (ikarus system $pairs) (ikarus system $vectors) @@ -27,7 +27,7 @@ (except (ikarus) make-eq-hashtable hashtable-ref hashtable-set! hashtable? hashtable-size hashtable-delete! hashtable-contains? hashtable-update! hashtable-keys hashtable-mutable? - hashtable-clear!)) + hashtable-clear! hashtable-entries)) (define-struct hasht (vec count tc mutable?)) @@ -260,6 +260,26 @@ [else (f i b kv)]))) ($fxsub1 j) kv v)))]))))) + (define (get-entries h) + (let ([v (hasht-vec h)] [n (hasht-count h)]) + (let ([kv (make-vector n)] [vv (make-vector n)]) + (let f ([i ($fxsub1 n)] [j ($fxsub1 (vector-length v))] [kv kv] [vv vv] [v v]) + (cond + [($fx= i -1) (values kv vv)] + [else + (let ([b ($vector-ref v j)]) + (if (fixnum? b) + (f i ($fxsub1 j) kv vv v) + (f (let f ([i i] [b b] [kv kv] [vv vv]) + ($vector-set! kv i ($tcbucket-key b)) + ($vector-set! vv i ($tcbucket-val b)) + (let ([b ($tcbucket-next b)] + [i ($fxsub1 i)]) + (cond + [(fixnum? b) i] + [else (f i b kv vv)]))) + ($fxsub1 j) kv vv v)))]))))) + ;;; public interface (define (hashtable? x) (hasht? x)) @@ -325,6 +345,11 @@ (error 'hashtable-delete! "hashtable is immutable" h)) (error 'hashtable-delete! "not a hash table" h)))) + (define (hashtable-entries h) + (if (hasht? h) + (get-entries h) + (error 'hashtable-entries "not a hash table" h))) + (define (hashtable-keys h) (if (hasht? h) (get-keys h) diff --git a/scheme/makefile.ss b/scheme/makefile.ss index d806737..a92ab7e 100755 --- a/scheme/makefile.ss +++ b/scheme/makefile.ss @@ -1165,7 +1165,7 @@ [hashtable-contains? i r ht] [hashtable-copy r ht] [hashtable-delete! i r ht] - [hashtable-entries r ht] + [hashtable-entries i r ht] [hashtable-keys i r ht] [hashtable-mutable? i r ht] [hashtable-ref i r ht] diff --git a/scheme/todo-r6rs.ss b/scheme/todo-r6rs.ss index a86ed9a..7deffe8 100755 --- a/scheme/todo-r6rs.ss +++ b/scheme/todo-r6rs.ss @@ -360,7 +360,7 @@ [fltan C fl] [fltruncate C fl] [flzero? C fl] - [real->flonum S fl] + [real->flonum C fl] [make-no-infinities-violation C fl] [make-no-nans-violation C fl] [&no-infinities C fl] @@ -685,7 +685,7 @@ [hashtable-contains? C ht] [hashtable-copy S ht] [hashtable-delete! C ht] - [hashtable-entries S ht] + [hashtable-entries C ht] [hashtable-keys C ht] [hashtable-mutable? C ht] [hashtable-ref C ht]