add unsafe-hash-iterate ops; add specific hash table sequences

- refactor for.rkt: abstract in-hash- definitions
- refactor hash_table_next in hash.c
- move hash fn headers to schpriv.h

closes #1229

pkgs/base/info.rkt

@@ -12,7 +12,7 @@
 
 (define collection 'multi)
 
-(define version "6.4.0.5")
+(define version "6.4.0.6")
 
 (define deps `("racket-lib"
                ["racket" #:version ,version]))

pkgs/racket-doc/scribblings/reference/sequences.scrbl

@@ -378,6 +378,53 @@ each element in the sequence.
       (printf "key and value: ~a\n" key+value))]
 }
 
+@deftogether[(
+@defproc[(in-mutable-hash 
+          [hash (and/c hash? (not/c immutable?) (not/c hash-weak?))]) 
+	  sequence?]
+@defproc[(in-mutable-hash-keys
+          [hash (and/c hash? (not/c immutable?) (not/c hash-weak?))]) 
+	  sequence?]
+@defproc[(in-mutable-hash-values
+          [hash (and/c hash? (not/c immutable?) (not/c hash-weak?))]) 
+	  sequence?]
+@defproc[(in-mutable-hash-pairs
+          [hash (and/c hash? (not/c immutable?) (not/c hash-weak?))]) 
+	  sequence?]
+@defproc[(in-immutable-hash 
+          [hash (and/c hash? immutable?)])
+	  sequence?]
+@defproc[(in-immutable-hash-keys
+          [hash (and/c hash? immutable?)])
+	  sequence?]
+@defproc[(in-immutable-hash-values
+          [hash (and/c hash? immutable?)])
+	  sequence?]
+@defproc[(in-immutable-hash-pairs
+          [hash (and/c hash? immutable?)])
+	  sequence?]
+@defproc[(in-weak-hash 
+          [hash (and/c hash? hash-weak?)]) 
+	  sequence?]
+@defproc[(in-weak-hash-keys
+          [hash (and/c hash? hash-weak?)]) 
+	  sequence?]
+@defproc[(in-weak-hash-values
+          [hash (and/c hash? hash-weak?)]) 
+	  sequence?]
+@defproc[(in-weak-hash-pairs
+          [hash (and/c hash? hash-weak?)]) 
+	  sequence?]
+)]{
+   Sequence constructors for specific kinds of hash tables.
+   
+   These may be more performant than the analogous @racket[in-hash] 
+   forms. However, they may consume more space to help with iteration.
+   
+   @history[#:added "6.4.0.6"]
+}
+
+
 @defproc[(in-directory [dir (or/c #f path-string?) #f]
                        [use-dir? ((and/c path? complete-path?) . -> . any/c)
                                  (lambda (dir-path) #t)])

pkgs/racket-doc/scribblings/reference/unsafe.scrbl

@@ -347,6 +347,94 @@ The index @racket[k] must be between @racket[0] (inclusive) and
 the number of fields in the structure (exclusive). In the case of
 @racket[unsafe-struct-set!], the field must be mutable.}
 
+@deftogether[(
+@defproc[(unsafe-mutable-hash-iterate-first
+          [h (and/c hash? (not/c immutable?) (not/c hash-weak?))])
+	  (or/c #f any/c)]
+@defproc[(unsafe-mutable-hash-iterate-next
+          [h (and/c hash? (not/c immutable?) (not/c hash-weak?))]
+	  [i any/c])
+	  (or/c #f any/c)]
+@defproc[(unsafe-mutable-hash-iterate-key
+          [h (and/c hash? (not/c immutable?) (not/c hash-weak?))]
+	  [i any/c]) 
+	  any/c]
+@defproc[(unsafe-mutable-hash-iterate-value
+          [h (and/c hash? (not/c immutable?) (not/c hash-weak?))]
+	  [i any/c]) 
+	  any/c]
+@defproc[(unsafe-mutable-hash-iterate-key+value
+          [h (and/c hash? (not/c immutable?) (not/c hash-weak?))]
+	  [i any/c]) 
+	  (values any/c any/c)]
+@defproc[(unsafe-mutable-hash-iterate-pair
+          [h (and/c hash? (not/c immutable?) (not/c hash-weak?))]
+	  [i any/c]) 
+	  pair?]
+@defproc[(unsafe-immutable-hash-iterate-first
+          [h (and/c hash? immutable?)])
+	  (or/c #f any/c)]
+@defproc[(unsafe-immutable-hash-iterate-next
+          [h (and/c hash? immutable?)]
+	  [i any/c])
+	  (or/c #f any/c)]
+@defproc[(unsafe-immutable-hash-iterate-key
+          [h (and/c hash? immutable?)]
+	  [i any/c]) 
+	  any/c]
+@defproc[(unsafe-immutable-hash-iterate-value
+          [h (and/c hash? immutable?)]
+	  [i any/c])
+	  any/c]
+@defproc[(unsafe-immutable-hash-iterate-key+value
+          [h (and/c hash? immutable?)]
+	  [i any/c])
+	  (values any/c any/c)]
+@defproc[(unsafe-immutable-hash-iterate-pair
+          [h (and/c hash? immutable?)]
+	  [i any/c])
+	  pair?]
+@defproc[(unsafe-weak-hash-iterate-first
+          [h (and/c hash? hash-weak?)])
+	  (or/c #f any/c)]
+@defproc[(unsafe-weak-hash-iterate-next
+          [h (and/c hash? hash-weak?)]
+	  [i any/c])
+	  (or/c #f any/c)]
+@defproc[(unsafe-weak-hash-iterate-key
+          [h (and/c hash? hash-weak?)]
+	  [i any/c]) 
+	  any/c]
+@defproc[(unsafe-weak-hash-iterate-value
+          [h (and/c hash? hash-weak?)]
+	  [i any/c]) 
+	  any/c]
+@defproc[(unsafe-weak-hash-iterate-key+value
+          [h (and/c hash? hash-weak?)]
+	  [i any/c]) 
+	  (values any/c any/c)]
+@defproc[(unsafe-weak-hash-iterate-pair
+          [h (and/c hash? hash-weak?)]
+	  [i any/c]) 
+	  pair?]
+)]{
+Unsafe versions of @racket[hash-iterate-key] and similar ops. These operations
+support @tech{chaperones} and @tech{impersonators}.
+
+Each unsafe @code{-first} and @code{-next} operation may not return a number
+index but rather an internal representation of a view into the hash structure,
+enabling faster iteration. 
+
+The result of these @code{-first} and @code{-next}] functions should be given
+to the corresponding unsafe accessor functions.
+
+If the key or value at the position returned by the @code{-first} and
+@code{-next} ops becomes invalid (e.g., because of mutation or garbage
+collection), then the operations @exnraise[exn:fail:contract].
+
+@history[#:added "6.4.0.6"]
+}
+
 @; ------------------------------------------------------------------------
 
 @section[#:tag "unsafeextfl"]{Unsafe Extflonum Operations}

pkgs/racket-test-core/tests/racket/hash.rktl

@@ -36,144 +36,240 @@
         h))
 
 (let ()
+  (define (test-hash-iterations lst1 lst2)
+    (define ht/immut (make-immutable-hash (map cons lst1 lst2)))
+    (define ht/mut (make-hash (map cons lst1 lst2)))
+    (define ht/weak (make-weak-hash (map cons lst1 lst2)))
+    
+    (define fake-ht/immut
+      (chaperone-hash 
+          ht/immut
+        (lambda (h k) (values k (lambda (h k v) v))) ; ref-proc
+        (lambda (h k v) values k v) ; set-proc
+        (lambda (h k) k) ; remove-proc
+        (lambda (h k) k))) ; key-proc
+    (define fake-ht/mut
+      (impersonate-hash 
+          ht/mut
+        (lambda (h k) (values k (lambda (h k v) v))) ; ref-proc
+        (lambda (h k v) values k v) ; set-proc
+        (lambda (h k) k) ; remove-proc
+        (lambda (h k) k))) ; key-proc
+    (define fake-ht/weak
+      (impersonate-hash 
+          ht/weak
+        (lambda (h k) (values k (lambda (h k v) v))) ; ref-proc
+        (lambda (h k v) values k v) ; set-proc
+        (lambda (h k) k) ; remove-proc
+        (lambda (h k) k))) ; key-proc
+    
+    (define ht/immut/seq (in-hash ht/immut))
+    (define ht/mut/seq (in-hash ht/mut))
+    (define ht/weak/seq (in-hash ht/weak))
+    (define ht/immut-pair/seq (in-hash-pairs ht/immut))
+    (define ht/mut-pair/seq (in-hash-pairs ht/mut))
+    (define ht/weak-pair/seq (in-hash-pairs ht/weak))
+    (define ht/immut-keys/seq (in-hash-keys ht/immut))
+    (define ht/mut-keys/seq (in-hash-keys ht/mut))
+    (define ht/weak-keys/seq (in-hash-keys ht/weak))
+    (define ht/immut-vals/seq (in-hash-values ht/immut))
+    (define ht/mut-vals/seq (in-hash-values ht/mut))
+    (define ht/weak-vals/seq (in-hash-values ht/weak))
+    
+    (test #t
+          =
+          (for/sum ([(k v) (in-hash ht/immut)]) (+ k v))
+          (for/sum ([(k v) (in-hash ht/mut)]) (+ k v))
+          (for/sum ([(k v) (in-hash ht/weak)]) (+ k v))
+          (for/sum ([(k v) (in-hash fake-ht/immut)]) (+ k v))
+          (for/sum ([(k v) (in-hash fake-ht/mut)]) (+ k v))
+          (for/sum ([(k v) (in-hash fake-ht/weak)]) (+ k v))
+          (for/sum ([(k v) ht/immut/seq]) (+ k v))
+          (for/sum ([(k v) ht/mut/seq]) (+ k v))
+          (for/sum ([(k v) ht/weak/seq]) (+ k v))
+          (for/sum ([k+v (in-hash-pairs ht/immut)]) (+ (car k+v) (cdr k+v)))
+          (for/sum ([k+v (in-hash-pairs ht/mut)]) (+ (car k+v) (cdr k+v)))
+          (for/sum ([k+v (in-hash-pairs ht/weak)]) (+ (car k+v) (cdr k+v)))
+          (for/sum ([k+v (in-hash-pairs fake-ht/immut)]) 
+            (+ (car k+v) (cdr k+v)))
+          (for/sum ([k+v (in-hash-pairs fake-ht/mut)]) 
+            (+ (car k+v) (cdr k+v)))
+          (for/sum ([k+v (in-hash-pairs fake-ht/weak)]) 
+            (+ (car k+v) (cdr k+v)))
+          (for/sum ([k+v ht/immut-pair/seq]) (+ (car k+v) (cdr k+v)))
+          (for/sum ([k+v ht/mut-pair/seq]) (+ (car k+v) (cdr k+v)))
+          (for/sum ([k+v ht/weak-pair/seq]) (+ (car k+v) (cdr k+v)))
+          (+ (for/sum ([k (in-hash-keys ht/immut)]) k)
+             (for/sum ([v (in-hash-values ht/immut)]) v))
+          (+ (for/sum ([k (in-hash-keys ht/mut)]) k)
+             (for/sum ([v (in-hash-values ht/mut)]) v))
+          (+ (for/sum ([k (in-hash-keys ht/weak)]) k)
+             (for/sum ([v (in-hash-values ht/weak)]) v))
+          (+ (for/sum ([k (in-hash-keys fake-ht/immut)]) k)
+             (for/sum ([v (in-hash-values fake-ht/immut)]) v))
+          (+ (for/sum ([k (in-hash-keys fake-ht/mut)]) k)
+             (for/sum ([v (in-hash-values fake-ht/mut)]) v))
+          (+ (for/sum ([k (in-hash-keys fake-ht/weak)]) k)
+             (for/sum ([v (in-hash-values fake-ht/weak)]) v))
+          (+ (for/sum ([k ht/immut-keys/seq]) k)
+             (for/sum ([v ht/immut-vals/seq]) v))
+          (+ (for/sum ([k ht/mut-keys/seq]) k)
+             (for/sum ([v ht/mut-vals/seq]) v))
+          (+ (for/sum ([k ht/weak-keys/seq]) k)
+             (for/sum ([v ht/weak-vals/seq]) v)))
+    
+    (test #t
+          =
+          (for/sum ([(k v) (in-hash ht/immut)]) k)
+          (for/sum ([(k v) (in-hash ht/mut)]) k)
+          (for/sum ([(k v) (in-hash ht/weak)]) k)
+          (for/sum ([(k v) (in-hash fake-ht/immut)]) k)
+          (for/sum ([(k v) (in-hash fake-ht/mut)]) k)
+          (for/sum ([(k v) (in-hash fake-ht/weak)]) k)
+          (for/sum ([(k v) ht/immut/seq]) k)
+          (for/sum ([(k v) ht/mut/seq]) k)
+          (for/sum ([(k v) ht/weak/seq]) k)
+          (for/sum ([k+v (in-hash-pairs ht/immut)]) (car k+v))
+          (for/sum ([k+v (in-hash-pairs ht/mut)]) (car k+v))
+          (for/sum ([k+v (in-hash-pairs ht/weak)]) (car k+v))
+          (for/sum ([k+v (in-hash-pairs fake-ht/immut)]) (car k+v))
+          (for/sum ([k+v (in-hash-pairs fake-ht/mut)]) (car k+v))
+          (for/sum ([k+v (in-hash-pairs fake-ht/weak)]) (car k+v))
+          (for/sum ([k+v ht/immut-pair/seq]) (car k+v))
+          (for/sum ([k+v ht/mut-pair/seq]) (car k+v))
+          (for/sum ([k+v ht/weak-pair/seq]) (car k+v))
+          (for/sum ([k (in-hash-keys ht/immut)]) k)
+          (for/sum ([k (in-hash-keys ht/mut)]) k)
+          (for/sum ([k (in-hash-keys ht/weak)]) k)
+          (for/sum ([k (in-hash-keys fake-ht/immut)]) k)
+          (for/sum ([k (in-hash-keys fake-ht/mut)]) k)
+          (for/sum ([k (in-hash-keys fake-ht/weak)]) k)
+          (for/sum ([k ht/immut-keys/seq]) k)
+          (for/sum ([k ht/mut-keys/seq]) k)
+          (for/sum ([k ht/weak-keys/seq]) k))
+    
+    (test #t
+          =
+          (for/sum ([(k v) (in-hash ht/immut)]) v)
+          (for/sum ([(k v) (in-hash ht/mut)]) v)
+          (for/sum ([(k v) (in-hash ht/weak)]) v)
+          (for/sum ([(k v) (in-hash fake-ht/immut)]) v)
+          (for/sum ([(k v) (in-hash fake-ht/mut)]) v)
+          (for/sum ([(k v) (in-hash fake-ht/weak)]) v)
+          (for/sum ([(k v) ht/immut/seq]) v)
+          (for/sum ([(k v) ht/mut/seq]) v)
+          (for/sum ([(k v) ht/weak/seq]) v)
+          (for/sum ([k+v (in-hash-pairs ht/immut)]) (cdr k+v))
+          (for/sum ([k+v (in-hash-pairs ht/mut)]) (cdr k+v))
+          (for/sum ([k+v (in-hash-pairs ht/weak)]) (cdr k+v))
+          (for/sum ([k+v (in-hash-pairs fake-ht/immut)]) (cdr k+v))
+          (for/sum ([k+v (in-hash-pairs fake-ht/mut)]) (cdr k+v))
+          (for/sum ([k+v (in-hash-pairs fake-ht/weak)]) (cdr k+v))
+          (for/sum ([k+v ht/immut-pair/seq]) (cdr k+v))
+          (for/sum ([k+v ht/mut-pair/seq]) (cdr k+v))
+          (for/sum ([k+v ht/weak-pair/seq]) (cdr k+v))
+          (for/sum ([v (in-hash-values ht/immut)]) v)
+          (for/sum ([v (in-hash-values ht/mut)]) v)
+          (for/sum ([v (in-hash-values ht/weak)]) v)
+          (for/sum ([v (in-hash-values fake-ht/immut)]) v)
+          (for/sum ([v (in-hash-values fake-ht/mut)]) v)
+          (for/sum ([v (in-hash-values fake-ht/weak)]) v)
+          (for/sum ([v ht/immut-vals/seq]) v)
+          (for/sum ([v ht/mut-vals/seq]) v)
+          (for/sum ([v ht/weak-vals/seq]) v)))
+  
   (define lst1 (build-list 10 values))
   (define lst2 (build-list 10 add1))
+  (test-hash-iterations lst1 lst2)
+  (define lst3 (build-list 100000 values))
+  (define lst4 (build-list 100000 add1))
+  (test-hash-iterations lst3 lst4))
 
-  (define ht/immut (make-immutable-hash (map cons lst1 lst2)))
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  (define ht/mut (make-hash (map cons lst1 lst2)))
-  (define ht/weak (make-weak-hash (map cons lst1 lst2)))
-  
-(define fake-ht/immut
-  (chaperone-hash 
-    ht/immut
-    (lambda (h k) (values k (lambda (h k v) v))) ; ref-proc
-    (lambda (h k v) values k v) ; set-proc
-    (lambda (h k) k) ; remove-proc
-    (lambda (h k) k))) ; key-proc
-(define fake-ht/mut
-  (impersonate-hash 
-    ht/mut
-    (lambda (h k) (values k (lambda (h k v) v))) ; ref-proc
-    (lambda (h k v) values k v) ; set-proc
-    (lambda (h k) k) ; remove-proc
-    (lambda (h k) k))) ; key-proc
-(define fake-ht/weak
-  (impersonate-hash 
-    ht/weak
-    (lambda (h k) (values k (lambda (h k v) v))) ; ref-proc
-    (lambda (h k v) values k v) ; set-proc
-    (lambda (h k) k) ; remove-proc
-    (lambda (h k) k))) ; key-proc
 
-  (define ht/immut/seq (in-hash ht/immut))
+(let ()
-  (define ht/mut/seq (in-hash ht/mut))
+  (define err-msg "no element at index")
-  (define ht/weak/seq (in-hash ht/weak))
-  (define ht/immut-pair/seq (in-hash-pairs ht/immut))
-  (define ht/mut-pair/seq (in-hash-pairs ht/mut))
-  (define ht/weak-pair/seq (in-hash-pairs ht/weak))
-  (define ht/immut-keys/seq (in-hash-keys ht/immut))
-  (define ht/mut-keys/seq (in-hash-keys ht/mut))
-  (define ht/weak-keys/seq (in-hash-keys ht/weak))
-  (define ht/immut-vals/seq (in-hash-values ht/immut))
-  (define ht/mut-vals/seq (in-hash-values ht/mut))
-  (define ht/weak-vals/seq (in-hash-values ht/weak))
 
+;; Check that unsafe-weak-hash-iterate- ops do not segfault
+;; when a key is collected before access; throw exception instead.
+;; They are used for safe iteration in in-weak-hash- sequence forms
+  (let ()
+    (define ht #f)
     
-  (test #t
+    (let ([lst (build-list 10 add1)])
-        =
+      (set! ht (make-weak-hash `((,lst . val)))))
-        (for/sum ([(k v) (in-hash ht/immut)]) (+ k v))
+    
-        (for/sum ([(k v) (in-hash ht/mut)]) (+ k v))
+    (define i (hash-iterate-first ht))
-        (for/sum ([(k v) (in-hash ht/weak)]) (+ k v))
+    
-        (for/sum ([(k v) (in-hash fake-ht/immut)]) (+ k v))
+    ;; everything ok
-        (for/sum ([(k v) (in-hash fake-ht/mut)]) (+ k v))
+    (test #t number? i)
-        (for/sum ([(k v) (in-hash fake-ht/weak)]) (+ k v))
+    (test #t list? (hash-iterate-key ht i))
-        (for/sum ([(k v) ht/immut/seq]) (+ k v))
+    (test #t equal? (hash-iterate-value ht i) 'val)
-        (for/sum ([(k v) ht/mut/seq]) (+ k v))
+    (test #t equal? (cdr (hash-iterate-pair ht i)) 'val)
-        (for/sum ([(k v) ht/weak/seq]) (+ k v))
+    (test #t equal? 
-        (for/sum ([k+v (in-hash-pairs ht/immut)]) (+ (car k+v) (cdr k+v)))
+          (call-with-values (lambda () (hash-iterate-key+value ht i)) cons)
-        (for/sum ([k+v (in-hash-pairs ht/mut)]) (+ (car k+v) (cdr k+v)))
+          '((1 2 3 4 5 6 7 8 9 10) . val))
-        (for/sum ([k+v (in-hash-pairs ht/weak)]) (+ (car k+v) (cdr k+v)))
+    (test #t boolean? (hash-iterate-next ht i))
-        (for/sum ([k+v (in-hash-pairs fake-ht/immut)]) (+ (car k+v) (cdr k+v)))
-        (for/sum ([k+v (in-hash-pairs fake-ht/mut)]) (+ (car k+v) (cdr k+v)))
-        (for/sum ([k+v (in-hash-pairs fake-ht/weak)]) (+ (car k+v) (cdr k+v)))
-        (for/sum ([k+v ht/immut-pair/seq]) (+ (car k+v) (cdr k+v)))
-        (for/sum ([k+v ht/mut-pair/seq]) (+ (car k+v) (cdr k+v)))
-        (for/sum ([k+v ht/weak-pair/seq]) (+ (car k+v) (cdr k+v)))
-        (+ (for/sum ([k (in-hash-keys ht/immut)]) k)
-           (for/sum ([v (in-hash-values ht/immut)]) v))
-        (+ (for/sum ([k (in-hash-keys ht/mut)]) k)
-           (for/sum ([v (in-hash-values ht/mut)]) v))
-        (+ (for/sum ([k (in-hash-keys ht/weak)]) k)
-           (for/sum ([v (in-hash-values ht/weak)]) v))
-        (+ (for/sum ([k (in-hash-keys fake-ht/immut)]) k)
-           (for/sum ([v (in-hash-values fake-ht/immut)]) v))
-        (+ (for/sum ([k (in-hash-keys fake-ht/mut)]) k)
-           (for/sum ([v (in-hash-values fake-ht/mut)]) v))
-        (+ (for/sum ([k (in-hash-keys fake-ht/weak)]) k)
-           (for/sum ([v (in-hash-values fake-ht/weak)]) v))
-        (+ (for/sum ([k ht/immut-keys/seq]) k)
-           (for/sum ([v ht/immut-vals/seq]) v))
-        (+ (for/sum ([k ht/mut-keys/seq]) k)
-           (for/sum ([v ht/mut-vals/seq]) v))
-        (+ (for/sum ([k ht/weak-keys/seq]) k)
-           (for/sum ([v ht/weak-vals/seq]) v)))
 
-  (test #t
+    ;; collect key, everything should error
-        =
+    (collect-garbage)(collect-garbage)(collect-garbage)
-        (for/sum ([(k v) (in-hash ht/immut)]) k)
+    (test #t boolean? (hash-iterate-first ht))
-        (for/sum ([(k v) (in-hash ht/mut)]) k)
+    (err/rt-test (hash-iterate-key ht i) exn:fail:contract? err-msg)
-        (for/sum ([(k v) (in-hash ht/weak)]) k)
+    (err/rt-test (hash-iterate-value ht i) exn:fail:contract? err-msg)
-        (for/sum ([(k v) (in-hash fake-ht/immut)]) k)
+    (err/rt-test (hash-iterate-pair ht i) exn:fail:contract? err-msg)
-        (for/sum ([(k v) (in-hash fake-ht/mut)]) k)
+    (err/rt-test (hash-iterate-key+value ht i) exn:fail:contract? err-msg)
-        (for/sum ([(k v) (in-hash fake-ht/weak)]) k)
+    (err/rt-test (hash-iterate-next ht i) exn:fail:contract? err-msg))    
-        (for/sum ([(k v) ht/immut/seq]) k)
-        (for/sum ([(k v) ht/mut/seq]) k)
-        (for/sum ([(k v) ht/weak/seq]) k)
-        (for/sum ([k+v (in-hash-pairs ht/immut)]) (car k+v))
-        (for/sum ([k+v (in-hash-pairs ht/mut)]) (car k+v))
-        (for/sum ([k+v (in-hash-pairs ht/weak)]) (car k+v))
-        (for/sum ([k+v (in-hash-pairs fake-ht/immut)]) (car k+v))
-        (for/sum ([k+v (in-hash-pairs fake-ht/mut)]) (car k+v))
-        (for/sum ([k+v (in-hash-pairs fake-ht/weak)]) (car k+v))
-        (for/sum ([k+v ht/immut-pair/seq]) (car k+v))
-        (for/sum ([k+v ht/mut-pair/seq]) (car k+v))
-        (for/sum ([k+v ht/weak-pair/seq]) (car k+v))
-        (for/sum ([k (in-hash-keys ht/immut)]) k)
-        (for/sum ([k (in-hash-keys ht/mut)]) k)
-        (for/sum ([k (in-hash-keys ht/weak)]) k)
-        (for/sum ([k (in-hash-keys fake-ht/immut)]) k)
-        (for/sum ([k (in-hash-keys fake-ht/mut)]) k)
-        (for/sum ([k (in-hash-keys fake-ht/weak)]) k)
-        (for/sum ([k ht/immut-keys/seq]) k)
-        (for/sum ([k ht/mut-keys/seq]) k)
-        (for/sum ([k ht/weak-keys/seq]) k))
 
-  (test #t
+;; Check that unsafe mutable hash table operations do not segfault
-        =
+;; after getting valid index from unsafe-mutable-hash-iterate-first and -next.
-        (for/sum ([(k v) (in-hash ht/immut)]) v)
+;; Throw exception instead since they're used for safe iteration
-        (for/sum ([(k v) (in-hash ht/mut)]) v)
+  (let ()
-        (for/sum ([(k v) (in-hash ht/weak)]) v)
+    (define ht (make-hash '((a . b))))
-        (for/sum ([(k v) (in-hash fake-ht/immut)]) v)
+    
-        (for/sum ([(k v) (in-hash fake-ht/mut)]) v)
+    (define i (hash-iterate-first ht))
-        (for/sum ([(k v) (in-hash fake-ht/weak)]) v)
+    
-        (for/sum ([(k v) ht/immut/seq]) v)
+    ;; everything ok
-        (for/sum ([(k v) ht/mut/seq]) v)
+    (test #t number? i)
-        (for/sum ([(k v) ht/weak/seq]) v)
+    (test #t equal? (hash-iterate-key ht i) 'a)
-        (for/sum ([k+v (in-hash-pairs ht/immut)]) (cdr k+v))
+    (test #t equal? (hash-iterate-value ht i) 'b)
-        (for/sum ([k+v (in-hash-pairs ht/mut)]) (cdr k+v))
+    (test #t equal? (hash-iterate-pair ht i) '(a . b))
-        (for/sum ([k+v (in-hash-pairs ht/weak)]) (cdr k+v))
+    (test #t equal? 
-        (for/sum ([k+v (in-hash-pairs fake-ht/immut)]) (cdr k+v))
+          (call-with-values (lambda () (hash-iterate-key+value ht i)) cons)
-        (for/sum ([k+v (in-hash-pairs fake-ht/mut)]) (cdr k+v))
+          '(a . b))
-        (for/sum ([k+v (in-hash-pairs fake-ht/weak)]) (cdr k+v))
+    (test #t boolean? (hash-iterate-next ht i))
-        (for/sum ([k+v ht/immut-pair/seq]) (cdr k+v))
+    
-        (for/sum ([k+v ht/mut-pair/seq]) (cdr k+v))
+    ;; remove element, everything should error
-        (for/sum ([k+v ht/weak-pair/seq]) (cdr k+v))
+    (hash-remove! ht 'a)
-        (for/sum ([v (in-hash-values ht/immut)]) v)
+    (test #t boolean? (hash-iterate-first ht))
-        (for/sum ([v (in-hash-values ht/mut)]) v)
+    (err/rt-test (hash-iterate-key ht i) exn:fail:contract? err-msg)
-        (for/sum ([v (in-hash-values ht/weak)]) v)
+    (err/rt-test (hash-iterate-value ht i) exn:fail:contract? err-msg)
-        (for/sum ([v (in-hash-values fake-ht/immut)]) v)
+    (err/rt-test (hash-iterate-pair ht i) exn:fail:contract? err-msg)
-        (for/sum ([v (in-hash-values fake-ht/mut)]) v)
+    (err/rt-test (hash-iterate-key+value ht i) exn:fail:contract? err-msg)
-        (for/sum ([v (in-hash-values fake-ht/weak)]) v)
+    (err/rt-test (hash-iterate-next ht i) exn:fail:contract? err-msg))    
-        (for/sum ([v ht/immut-vals/seq]) v)
+    
-        (for/sum ([v ht/mut-vals/seq]) v)
+
-        (for/sum ([v ht/weak-vals/seq]) v)))
+  (let ()
+    (define ht (make-weak-hash '((a . b))))
+    
+    (define i (hash-iterate-first ht))
+    
+    ;; everything ok
+    (test #t number? i)
+    (test #t equal? (hash-iterate-key ht i) 'a)
+    (test #t equal? (hash-iterate-value ht i) 'b)
+    (test #t equal? (hash-iterate-pair ht i) '(a . b))
+    (test #t equal? (call-with-values 
+                        (lambda () (hash-iterate-key+value ht i)) cons)
+                    '(a . b))
+    (test #t boolean? (hash-iterate-next ht i))
+
+    ;; remove element, everything should error
+    (hash-remove! ht 'a)
+    (test #t boolean? (hash-iterate-first ht))
+    (err/rt-test (hash-iterate-key ht i) exn:fail:contract?)
+    (err/rt-test (hash-iterate-value ht i) exn:fail:contract?)
+    (err/rt-test (hash-iterate-pair ht i) exn:fail:contract?)
+    (err/rt-test (hash-iterate-key+value ht i) exn:fail:contract?)
+    (err/rt-test (hash-iterate-next ht i) exn:fail:contract?)))
+
+(report-errs)

pkgs/racket-test-core/tests/racket/testing.rktl

@@ -217,7 +217,6 @@ transcript.
        (syntax
 	(thunk-error-test (err:mz:lambda () e) (quote-syntax e) exn?))]
       [(_ e exn? msg-rx)
-       (regexp? (syntax-e #'msg-rx))
        #'(thunk-error-test
           (err:mz:lambda () e)
           (quote-syntax e)

pkgs/racket-test-core/tests/racket/unsafe.rktl

@@ -579,4 +579,104 @@
 
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(let ()
+  (define err-msg "no element at index")
+
+;; Check that unsafe-weak-hash-iterate- ops do not segfault
+;; when a key is collected before access; throw exception instead.
+;; They are used for safe iteration in in-weak-hash- sequence forms
+  (let ()
+    (define ht #f)
+
+    (let ([lst (build-list 10 add1)])
+      (set! ht (make-weak-hash `((,lst . val)))))
+
+    (define i (unsafe-weak-hash-iterate-first ht))
+
+    ;; everything ok
+    (test #t number? i)
+    (test #t list? (unsafe-weak-hash-iterate-key ht i))
+    (test #t equal? (unsafe-weak-hash-iterate-value ht i) 'val)
+    (test #t equal? (cdr (unsafe-weak-hash-iterate-pair ht i)) 'val)
+    (test #t equal? 
+          (call-with-values 
+              (lambda () (unsafe-weak-hash-iterate-key+value ht i)) cons)
+          '((1 2 3 4 5 6 7 8 9 10) . val))
+    (test #t boolean? (unsafe-weak-hash-iterate-next ht i))
+
+    ;; collect key, everything should error (but not segfault)
+    (collect-garbage)(collect-garbage)(collect-garbage)
+    (test #t boolean? (unsafe-weak-hash-iterate-first ht))
+    (err/rt-test
+        (unsafe-weak-hash-iterate-key ht i) exn:fail:contract? err-msg)
+    (err/rt-test
+        (unsafe-weak-hash-iterate-value ht i) exn:fail:contract? err-msg)
+    (err/rt-test
+        (unsafe-weak-hash-iterate-pair ht i) exn:fail:contract? err-msg)
+    (err/rt-test
+        (unsafe-weak-hash-iterate-key+value ht i) exn:fail:contract? err-msg)
+    (err/rt-test
+        (unsafe-weak-hash-iterate-next ht i) exn:fail:contract? err-msg))
+
+;; Check that unsafe mutable hash table operations do not segfault
+;; after getting valid index from unsafe-mutable-hash-iterate-first and -next.
+;; Throw exception instead since they're used for safe iteration
+  (let ()
+    (define ht (make-hash '((a . b))))
+    (define i (unsafe-mutable-hash-iterate-first ht))
+
+    ;; everything ok
+    (test #t number? i)
+    (test #t equal? (unsafe-mutable-hash-iterate-key ht i) 'a)
+    (test #t equal? (unsafe-mutable-hash-iterate-value ht i) 'b)
+    (test #t equal? (unsafe-mutable-hash-iterate-pair ht i) '(a . b))
+    (test #t equal? 
+          (call-with-values 
+              (lambda () (unsafe-mutable-hash-iterate-key+value ht i)) cons)
+          '(a . b))
+    (test #t boolean? (unsafe-mutable-hash-iterate-next ht i))
+    
+    ;; remove element, everything should error (but not segfault)
+    (hash-remove! ht 'a)
+    (test #t boolean? (unsafe-mutable-hash-iterate-first ht))
+    (err/rt-test
+        (unsafe-mutable-hash-iterate-key ht i) exn:fail:contract? err-msg)
+    (err/rt-test
+        (unsafe-mutable-hash-iterate-value ht i) exn:fail:contract? err-msg)
+    (err/rt-test
+        (unsafe-mutable-hash-iterate-pair ht i) exn:fail:contract? err-msg)
+    (err/rt-test
+        (unsafe-mutable-hash-iterate-key+value ht i) exn:fail:contract? err-msg)
+    (err/rt-test
+        (unsafe-mutable-hash-iterate-next ht i) exn:fail:contract? err-msg))
+
+  (let ()
+    (define ht (make-weak-hash '((a . b))))
+    (define i (unsafe-weak-hash-iterate-first ht))
+    
+    ;; everything ok
+    (test #t number? i)
+    (test #t equal? (unsafe-weak-hash-iterate-key ht i) 'a)
+    (test #t equal? (unsafe-weak-hash-iterate-value ht i) 'b)
+    (test #t equal? (unsafe-weak-hash-iterate-pair ht i) '(a . b))
+    (test #t equal? 
+          (call-with-values 
+              (lambda () (unsafe-weak-hash-iterate-key+value ht i)) cons)
+          '(a . b))
+    (test #t boolean? (unsafe-weak-hash-iterate-next ht i))
+
+    ;; remove element, everything should error (but not segfault)
+    (hash-remove! ht 'a)
+    (test #t boolean? (unsafe-weak-hash-iterate-first ht))
+    (err/rt-test
+        (unsafe-weak-hash-iterate-key ht i) exn:fail:contract? err-msg)
+    (err/rt-test
+        (unsafe-weak-hash-iterate-value ht i) exn:fail:contract? err-msg)
+    (err/rt-test
+        (unsafe-weak-hash-iterate-pair ht i) exn:fail:contract? err-msg)
+    (err/rt-test
+        (unsafe-weak-hash-iterate-key+value ht i) exn:fail:contract? err-msg)
+    (err/rt-test
+        (unsafe-weak-hash-iterate-next ht i) exn:fail:contract? err-msg)))
+
 (report-errs)

racket/collects/racket/private/for.rkt

@@ -48,10 +48,24 @@
              (rename *in-port in-port)
              (rename *in-lines in-lines)
              (rename *in-bytes-lines in-bytes-lines)
-             (rename *in-hash in-hash)
+             
-             (rename *in-hash-keys in-hash-keys)
+             (rename in-hash-key+values in-hash)
-             (rename *in-hash-values in-hash-values)
+             in-hash-keys
-             (rename *in-hash-pairs in-hash-pairs)
+             in-hash-values
+             in-hash-pairs
+             (rename in-mutable-hash-key+values in-mutable-hash)
+             in-mutable-hash-keys
+             in-mutable-hash-values
+             in-mutable-hash-pairs
+             (rename in-immutable-hash-key+values in-immutable-hash)
+             in-immutable-hash-keys
+             in-immutable-hash-values
+             in-immutable-hash-pairs
+             (rename in-weak-hash-key+values in-weak-hash)
+             in-weak-hash-keys
+             in-weak-hash-values
+             in-weak-hash-pairs
+
              in-directory
 
              in-sequences
@@ -88,6 +102,17 @@
              (for-syntax make-in-vector-like
                          for-clause-syntax-protect))
 
+  ;; redefininition of functions not in #%kernel
+  (begin-for-syntax
+    (define (format-id ctx str . args)
+      (define datum 
+        (string->symbol (apply format str (map syntax->datum args))))
+      (datum->syntax ctx datum))
+    (define (init-list n val)
+      (if (zero? n) 
+          null 
+          (cons val (init-list (sub1 n) val)))))
+  
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;; sequence transformers:
 
@@ -171,7 +196,7 @@
 
     (define (for-clause-syntax-protect clause)
       ;; This is slightly painful. The expansion into `:do-in' involves a lot
-      ;; of pieces that are no treated as sub-expressions. We have to push the
+      ;; of pieces that are not treated as sub-expressions. We have to push the
       ;; taints down to all the relevant identifiers and expressions:
       (arm-for-clause clause syntax-arm))
 
@@ -492,7 +517,7 @@
       [(string? v) (:string-gen v 0 (string-length v) 1)]
       [(bytes? v) (:bytes-gen v 0 (bytes-length v) 1)]
       [(input-port? v) (:input-port-gen v)]
-      [(hash? v) (:hash-key+val-gen v)]
+      [(hash? v) (:hash-gen v hash-iterate-key+value)]
       [(sequence-via-prop? v) ((sequence-ref v) v)]
       [(:sequence? v) (make-sequence who ((:sequence-ref v) v))]
       [(stream? v) (:stream-gen v)]
@@ -656,128 +681,20 @@
        (check-in-bytes-lines p mode)
        (in-producer (lambda () (read-bytes-line p mode)) eof)]))
 
-  (define (in-hash ht)
+  (define (in-stream l)
-    (unless (hash? ht) (raise-argument-error 'in-hash "hash?" ht))
+    (unless (stream? l) (raise-argument-error 'in-stream "stream?" l))
-    (make-do-sequence (lambda () (:hash-key+val-gen ht))))
+    (make-do-sequence (lambda () (:stream-gen l))))
+  
+  (define (:stream-gen l)
+    (values 
+     unsafe-stream-first unsafe-stream-rest l unsafe-stream-not-empty? #f #f))
 
-  (define (:hash-key+val-gen ht) (:hash-gen ht hash-iterate-key+value))
-
-  (define-sequence-syntax *in-hash
-    (lambda () #'in-hash)
-    (lambda (stx)
-      (syntax-case stx ()
-        [[(k v) (_ ht-expr)]
-         (for-clause-syntax-protect
-          #'[(k v)
-             (:do-in
-              ;;outer bindings
-              ([(ht) ht-expr])
-              ;; outer check
-              (unless (hash? ht) (in-hash ht))
-              ;; loop bindings
-              ([i (hash-iterate-first ht)])
-              ;; pos check
-              i
-              ;; inner bindings
-              ([(k v) (hash-iterate-key+value ht i)])
-              ;; pre guard
-              #t
-              ;; post guard
-              #t
-              ;; loop args
-              ((hash-iterate-next ht i)))])]
-        [_ #f])))
-
-  (define (in-hash-keys ht)
-    (unless (hash? ht) (raise-argument-error 'in-hash-keys "hash?" ht))
-    (make-do-sequence (lambda () (:hash-gen ht hash-iterate-key))))
-
-  (define-sequence-syntax *in-hash-keys
-    (lambda () #'in-hash-keys)
-    (lambda (stx)
-      (syntax-case stx ()
-        [[(id) (_ ht-expr)]
-         (for-clause-syntax-protect
-          #'[(id)
-             (:do-in
-              ;;outer bindings
-              ([(ht) ht-expr])
-              ;; outer check
-              (unless (hash? ht) (in-hash-keys ht))
-              ;; loop bindings
-              ([i (hash-iterate-first ht)])
-              ;; pos check
-              i
-              ;; inner bindings
-              ([(id) (hash-iterate-key ht i)])
-              ;; pre guard
-              #t
-              ;; post guard
-              #t
-              ;; loop args
-              ((hash-iterate-next ht i)))])]
-        [_ #f])))
-
-  (define (in-hash-values ht)
-    (unless (hash? ht) (raise-argument-error 'in-hash-values "hash?" ht))
-    (make-do-sequence (lambda () (:hash-gen ht hash-iterate-value))))
-
-  (define-sequence-syntax *in-hash-values
-    (lambda () #'in-hash-values)
-    (lambda (stx)
-      (syntax-case stx ()
-        [[(id) (_ ht-expr)]
-         (for-clause-syntax-protect
-          #'[(id)
-             (:do-in
-              ;;outer bindings
-              ([(ht) ht-expr])
-              ;; outer check
-              (unless (hash? ht) (in-hash-values ht))
-              ;; loop bindings
-              ([i (hash-iterate-first ht)])
-              ;; pos check
-              i
-              ;; inner bindings
-              ([(id) (hash-iterate-value ht i)])
-              ;; pre guard
-              #t
-              ;; post guard
-              #t
-              ;; loop args
-              ((hash-iterate-next ht i)))])]
-        [_ #f])))
-
-  (define (in-hash-pairs ht)
-    (unless (hash? ht) (raise-argument-error 'in-hash-values "hash?" ht))
-    (make-do-sequence (lambda () (:hash-gen ht hash-iterate-pair))))
-
-  (define-sequence-syntax *in-hash-pairs
-    (lambda () #'in-hash-pairs)
-    (lambda (stx)
-      (syntax-case stx ()
-        [[(id) (_ ht-expr)]
-         (for-clause-syntax-protect
-          #'[(id)
-             (:do-in
-              ;;outer bindings
-              ([(ht) ht-expr])
-              ;; outer check
-              (unless (hash? ht) (in-hash-pairs ht))
-              ;; loop bindings
-              ([i (hash-iterate-first ht)])
-              ;; pos check
-              i
-              ;; inner bindings
-              ([(id) (hash-iterate-pair ht i)])
-              ;; pre guard
-              #t
-              ;; post guard
-              #t
-              ;; loop args
-              ((hash-iterate-next ht i)))])]
-        [_ #f])))
 
+  ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; hash sequences
+  
+  ;; assembles hash iterator functions to give to make-do-sequence
   (define (:hash-gen ht sel)
     (values (lambda (pos) (sel ht pos))
             (lambda (pos) (hash-iterate-next ht pos))
@@ -786,12 +703,109 @@
             #f
             #f))
 
-  (define (in-stream l)
+  ;; each call defines 4 in-hash- sequences for a kind of VAL
-    (unless (stream? l) (raise-argument-error 'in-stream "stream?" l))
+  ;; - one generic
-    (make-do-sequence (lambda () (:stream-gen l))))
+  ;; - one for each hash table type: immutable, mutable, weak
-
+  ;; where VAL = key, value, pair, etc
-  (define (:stream-gen l)
+  (define-syntax (define-in-hash-sequences stx)
-    (values unsafe-stream-first unsafe-stream-rest l unsafe-stream-not-empty? #f #f))
+    (syntax-case stx (element-type: num-vals:)
+     [(_ element-type: VAL) ; eg, VAL = key, value, pair
+      #'(define-in-hash-sequences element-type: VAL num-vals: 1)]
+     [(_ element-type: VAL num-vals: n) 
+      (with-syntax 
+       ([IN-HASH-SEQUENCE-DEFINER-NAME
+            (format-id #'VAL "define-in-hash-~as-sequence" #'VAL)]
+        [FALLBACK-SEQUENCE-NAME (format-id #'VAL "default-in-hash-~as" #'VAL)]
+        [-fallback-accessor (format-id #'VAL "hash-iterate-~a" #'VAL)]
+        [IDs (generate-temporaries (init-list (syntax-e #'n) 'x))])
+       #'(begin
+          ;; 1) define fallback sequence constructor function for VAL type
+          ;;    (using make-do-sequence)
+          (define (FALLBACK-SEQUENCE-NAME ht)
+            (unless (hash? ht) 
+              (raise-argument-error 'FALLBACK-SEQUENCE-NAME "hash?" ht))
+            (make-do-sequence (lambda () (:hash-gen ht -fallback-accessor))))
+          ;; 2) define sequence syntax definer
+          ;; defines sequences in-HASHTYPE-hash-VALs, eg:
+          ;; - in-mutable-hash-keys
+          ;; - in-immutable-hash-pairs, etc
+          (define-syntax (IN-HASH-SEQUENCE-DEFINER-NAME stx)
+            (syntax-case stx (hash-type: outer-check: => :generic)
+             ;; defines generic in-hash-VALs sequence
+             [(def :generic)
+              (with-syntax 
+               ([_generic-sequence-name (format-id #'def "in-hash-~as" #'VAL)]
+                [_safe-iterate-fn-prefix (format-id #'def "hash-iterate")])
+               #'(IN-HASH-SEQUENCE-DEFINER-NAME
+                   _generic-sequence-name
+                   _safe-iterate-fn-prefix
+                   outer-check: (ht) => (hash? ht)))]
+             ;; defines in-hash-VALs sequence for a specific kind of hash table
+             ;; eg, HASHTYPE = mutable, immutable, weak
+             [(def hash-type: HASHTYPE outer-check: . test-clause)
+              (with-syntax 
+               ([_sequence-name
+                    (format-id #'def "in-~a-hash-~as" #'HASHTYPE #'VAL)]
+                [_unsafe-iterate-fn-prefix
+                    (format-id #'def "unsafe-~a-hash-iterate" #'HASHTYPE)])
+               #'(IN-HASH-SEQUENCE-DEFINER-NAME
+                   _sequence-name
+                   _unsafe-iterate-fn-prefix
+                   outer-check: . test-clause))]
+             ;; main (internal) clause
+             [(_ IN-HASH-SEQUENCE-NAME PREFIX outer-check: (HT) => TEST-EXPR) 
+              (with-syntax
+               ([-iterate-first (format-id #'PREFIX "~a-first" #'PREFIX)]
+                [-iterate-next (format-id #'PREFIX "~a-next" #'PREFIX)]
+                [-iterate-VAL (format-id #'PREFIX "~a-~a" #'PREFIX #'VAL)])
+               #'(define-sequence-syntax IN-HASH-SEQUENCE-NAME
+                  (lambda () #'FALLBACK-SEQUENCE-NAME)
+                  (lambda (stx)
+                    (syntax-case stx ()
+                     [[IDs (_ ht-expr)]
+                      (for-clause-syntax-protect
+                       #'[IDs
+                          (:do-in
+                           ;;outer bindings
+                           ([(HT) ht-expr])
+                           ;; outer check
+                           (unless TEST-EXPR (FALLBACK-SEQUENCE-NAME HT))
+                           ;; loop bindings
+                           ([i (-iterate-first HT)])
+                           ;; pos check
+                           i
+                           ;; inner bindings
+                           ([IDs (-iterate-VAL HT i)])
+                           ;; pre guard
+                           #t
+                           ;; post guard
+                           #t
+                           ;; loop args
+                           ((-iterate-next HT i)))])]
+                     [_ #f]))))]))
+          ;; 3) define sequence syntaxes (using definer):
+          ;;    - in-hash-VALs, works for any hash table
+          ;;    - one in-HASHTYPE-hash-VALs for each kind of hash table:
+          ;;      - immutable, mutable, and weak
+          ;;      - enables faster iteration using unsafe functions
+          (IN-HASH-SEQUENCE-DEFINER-NAME :generic)
+          (IN-HASH-SEQUENCE-DEFINER-NAME
+              hash-type: mutable 
+              outer-check: (ht) => (and (hash? ht) 
+                                        (not (immutable? ht))
+                                        (not (hash-weak? ht))))
+          (IN-HASH-SEQUENCE-DEFINER-NAME
+              hash-type: immutable
+              outer-check: (ht) => (and (hash? ht) (immutable? ht)))
+          (IN-HASH-SEQUENCE-DEFINER-NAME
+              hash-type: weak
+              outer-check: (ht) => (and (hash? ht) (hash-weak? ht)))
+          ))]))
+  
+  (define-in-hash-sequences element-type: key+value num-vals: 2)
+  (define-in-hash-sequences element-type: key)
+  (define-in-hash-sequences element-type: value)
+  (define-in-hash-sequences element-type: pair)
 
   ;; Vector-like sequences --------------------------------------------------
 

racket/src/racket/src/env.c

@@ -337,6 +337,7 @@ static void init_unsafe(Scheme_Env *env)
   scheme_init_unsafe_numarith(unsafe_env);
   scheme_init_unsafe_numcomp(unsafe_env);
   scheme_init_unsafe_list(unsafe_env);
+  scheme_init_unsafe_hash(unsafe_env);
   scheme_init_unsafe_vector(unsafe_env);
   scheme_init_unsafe_fun(unsafe_env);
 

racket/src/racket/src/hash.c

@@ -657,7 +657,24 @@ void scheme_reset_hash_table(Scheme_Hash_Table *table, int *history)
   table->mcount = 0;
 }
 
-int scheme_hash_table_index(Scheme_Hash_Table *hash, mzlonglong pos, Scheme_Object **_key, Scheme_Object **_val)
+Scheme_Object *scheme_hash_table_next(Scheme_Hash_Table *hash,
+				      mzlonglong start)
+{
+    int i, sz = hash->size;
+    if (start >= 0) {
+      if ((start >= sz) || !hash->vals[start])
+        return NULL;
+    }
+    for (i = start + 1; i < sz; i++) {
+      if (hash->vals[i])
+        return scheme_make_integer(i);
+    }
+
+    return scheme_false;
+}
+
+int scheme_hash_table_index(Scheme_Hash_Table *hash, mzlonglong pos,
+			    Scheme_Object **_key, Scheme_Object **_val)
 {
   if (pos < hash->size) {
     if (hash->vals[pos]) {
@@ -1117,6 +1134,27 @@ Scheme_Bucket_Table *scheme_clone_bucket_table(Scheme_Bucket_Table *bt)
   return table;
 }
 
+Scheme_Object *scheme_bucket_table_next(Scheme_Bucket_Table *hash,
+					mzlonglong start)
+{
+  Scheme_Bucket *bucket;
+  int i, sz = hash->size;
+    
+  if (start >= 0) {
+    bucket = ((start < sz) ? hash->buckets[start] : NULL);
+    if (!bucket || !bucket->val || !bucket->key) 
+      return NULL;      
+  }
+  for (i = start + 1; i < sz; i++) {
+    bucket = hash->buckets[i];
+    if (bucket && bucket->val && bucket->key) {
+      return scheme_make_integer(i);
+    }
+  }
+
+  return scheme_false;
+}
+
 int scheme_bucket_table_index(Scheme_Bucket_Table *hash, mzlonglong pos, Scheme_Object **_key, Scheme_Object **_val)
 {
   Scheme_Bucket *bucket;
@@ -2669,17 +2707,24 @@ static Scheme_Hash_Tree *hamt_remove(Scheme_Hash_Tree *ht, uintptr_t code, int s
     return ht;
 }
 
+/* this signature is different from other scheme_<hash type>_next fns */
+/* but is used else where, so leave as is */
 mzlonglong scheme_hash_tree_next(Scheme_Hash_Tree *tree, mzlonglong pos)
 {
-  if (pos == -1)
+  mzlonglong i = pos+1;
-    pos = 0;
+  if (i == tree->count)
-  else
-    pos++;
-  
-  if (pos == tree->count)
     return -1;
   else
-    return pos;
+    return i;
+}
+
+Scheme_Object *scheme_hash_tree_next_pos(Scheme_Hash_Tree *tree, mzlonglong pos)
+{
+  mzlonglong i = pos+1;
+  if (i == tree->count)
+    return scheme_false;
+  else
+    return scheme_make_integer_value_from_long_long(i);
 }
 
 #if REVERSE_HASH_TABLE_ORDER
@@ -2690,6 +2735,81 @@ mzlonglong scheme_hash_tree_next(Scheme_Hash_Tree *tree, mzlonglong pos)
 # define HAMT_TRAVERSE_NEXT(i) ((i)+1)
 #endif
 
+/* instead of returning a pos, these unsafe iteration ops */
+/* return a view into the tree consisting of a: */
+/*   - subtree */
+/*   - subtree index */
+/*   - stack of parent subtrees and indices */
+/* This speeds up performance of immutable hash table iteration. */
+/* These unsafe ops currently do not support REVERSE_HASH_TABLE_ORDER */
+/* to avoid unneeded popcount computations */
+Scheme_Object *scheme_unsafe_hash_tree_start(Scheme_Hash_Tree *ht)
+{
+  Scheme_Object *stack = scheme_null;
+  int i;
+
+  ht = resolve_placeholder(ht);
+
+  if (0 == ht->count)
+    return scheme_false;
+
+  i = hamt_popcount(ht->bitmap)-1;
+
+  while (1) {
+    if (HASHTR_SUBTREEP(ht->els[i])
+	|| HASHTR_COLLISIONP(ht->els[i])) {
+      stack = /* go down tree but save return point */
+	scheme_make_pair((Scheme_Object *)ht,
+			 scheme_make_pair(scheme_make_integer(i),
+					  stack));
+      ht = (Scheme_Hash_Tree *)ht->els[i];
+      i = hamt_popcount(ht->bitmap)-1;
+    } else {
+      return scheme_make_pair((Scheme_Object *)ht,
+			      scheme_make_pair(scheme_make_integer(i),
+					       stack));
+    }
+  }
+  return NULL;
+}
+
+/* args is a (cons subtree (cons subtree-index stack-of-parents)) */
+Scheme_Object *scheme_unsafe_hash_tree_next(Scheme_Object *args)
+{
+  Scheme_Hash_Tree *ht = (Scheme_Hash_Tree *)SCHEME_CAR(args);
+  int i = SCHEME_INT_VAL(SCHEME_CADR(args));
+  Scheme_Object *stack = SCHEME_CDDR(args);
+
+  /* ht = resolve_placeholder(ht); /\* only check this in iterate-first *\/ */
+
+  while(1) {
+    if (!i) { /* pop up the tree */
+      if (SCHEME_NULLP(stack)) {
+	return scheme_false;
+      } else {
+	ht = (Scheme_Hash_Tree *)SCHEME_CAR(stack);
+	i = SCHEME_INT_VAL(SCHEME_CADR(stack));
+	stack = SCHEME_CDDR(stack);
+      }
+    } else { 
+      i -= 1;
+      if (HASHTR_SUBTREEP(ht->els[i])
+	  || HASHTR_COLLISIONP(ht->els[i])) {
+	stack = /* go down tree but save return point */
+	  scheme_make_pair((Scheme_Object *)ht,
+			   scheme_make_pair(scheme_make_integer(i),
+					    stack));
+	ht = (Scheme_Hash_Tree *)ht->els[i];
+	i = hamt_popcount(ht->bitmap);
+      } else {
+	return scheme_make_pair((Scheme_Object *)ht,
+				scheme_make_pair(scheme_make_integer(i),
+						 stack));
+      }
+    }
+  }
+  return NULL;
+}
 
 XFORM_NONGCING static void hamt_at_index(Scheme_Hash_Tree *ht, mzlonglong pos,
                                          Scheme_Object **_key, Scheme_Object **_val, uintptr_t *_code)

racket/src/racket/src/list.c

@@ -175,7 +175,30 @@ static Scheme_Object *unsafe_unbox_star (int argc, Scheme_Object *argv[]);
 static Scheme_Object *unsafe_set_box (int argc, Scheme_Object *argv[]);
 static Scheme_Object *unsafe_set_box_star (int argc, Scheme_Object *argv[]);
 
+/* unsafe_scheme_hash_table */
+Scheme_Object *unsafe_scheme_hash_table_iterate_start(int argc, Scheme_Object *argv[]);
+Scheme_Object *unsafe_scheme_hash_table_iterate_next(int argc, Scheme_Object *argv[]);
+Scheme_Object *unsafe_scheme_hash_table_iterate_key(int argc, Scheme_Object *argv[]);
+Scheme_Object *unsafe_scheme_hash_table_iterate_value(int argc, Scheme_Object *argv[]);
+Scheme_Object *unsafe_scheme_hash_table_iterate_pair(int argc, Scheme_Object *argv[]);
+Scheme_Object *unsafe_scheme_hash_table_iterate_key_value(int argc, Scheme_Object *argv[]);
+/* unsafe_scheme_hash_tree */
+Scheme_Object *unsafe_scheme_hash_tree_iterate_start(int argc, Scheme_Object *argv[]);
+Scheme_Object *unsafe_scheme_hash_tree_iterate_next(int argc, Scheme_Object *argv[]);
+Scheme_Object *unsafe_scheme_hash_tree_iterate_key(int argc, Scheme_Object *argv[]);
+Scheme_Object *unsafe_scheme_hash_tree_iterate_value(int argc, Scheme_Object *argv[]);
+Scheme_Object *unsafe_scheme_hash_tree_iterate_pair(int argc, Scheme_Object *argv[]);
+Scheme_Object *unsafe_scheme_hash_tree_iterate_key_value(int argc, Scheme_Object *argv[]);
+/* unsafe_scheme_bucket_table */
+Scheme_Object *unsafe_scheme_bucket_table_iterate_start(int argc, Scheme_Object *argv[]);
+Scheme_Object *unsafe_scheme_bucket_table_iterate_next(int argc, Scheme_Object *argv[]);
+Scheme_Object *unsafe_scheme_bucket_table_iterate_key(int argc, Scheme_Object *argv[]);
+Scheme_Object *unsafe_scheme_bucket_table_iterate_value(int argc, Scheme_Object *argv[]);
+Scheme_Object *unsafe_scheme_bucket_table_iterate_pair(int argc, Scheme_Object *argv[]);
+Scheme_Object *unsafe_scheme_bucket_table_iterate_key_value(int argc, Scheme_Object *argv[]);
+
 static Scheme_Object *chaperone_hash_key(const char *name, Scheme_Object *table, Scheme_Object *key);
+static void chaperone_hash_key_value(const char *name, Scheme_Object *obj, Scheme_Object *k, Scheme_Object **_chap_key, Scheme_Object **_chap_val, int ischap);
 static Scheme_Object *chaperone_hash_tree_set(Scheme_Object *table, Scheme_Object *key, Scheme_Object *val);
 static Scheme_Object *chaperone_hash_clear(const char *name, Scheme_Object *table);
 
@@ -861,6 +884,143 @@ scheme_init_unsafe_list (Scheme_Env *env)
 
 }
 
+void
+scheme_init_unsafe_hash (Scheme_Env *env)
+{
+  Scheme_Object *p;
+
+  /* unsafe-hash-iterate-first ---------------------------------------- */
+  p = scheme_make_immed_prim(unsafe_scheme_hash_table_iterate_start,
+			     "unsafe-mutable-hash-iterate-first", 1, 1);
+  SCHEME_PRIM_PROC_FLAGS(p) |=
+    scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
+  scheme_add_global_constant ("unsafe-mutable-hash-iterate-first", p, env);
+
+  p = scheme_make_immed_prim(unsafe_scheme_hash_tree_iterate_start,
+			     "unsafe-immutable-hash-iterate-first", 1, 1);
+  SCHEME_PRIM_PROC_FLAGS(p) |=
+    scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
+  scheme_add_global_constant ("unsafe-immutable-hash-iterate-first", p, env);
+
+  p = scheme_make_immed_prim(unsafe_scheme_bucket_table_iterate_start,
+			     "unsafe-weak-hash-iterate-first", 1, 1);
+  SCHEME_PRIM_PROC_FLAGS(p) |=
+    scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
+  scheme_add_global_constant ("unsafe-weak-hash-iterate-first", p, env);
+
+  /* unsafe-hash-iterate-next ---------------------------------------- */
+  p = scheme_make_immed_prim(unsafe_scheme_hash_table_iterate_next,
+			     "unsafe-mutable-hash-iterate-next", 2, 2);
+  SCHEME_PRIM_PROC_FLAGS(p) |=
+    scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
+  scheme_add_global_constant ("unsafe-mutable-hash-iterate-next", p, env);
+
+  p = scheme_make_immed_prim(unsafe_scheme_hash_tree_iterate_next,
+			     "unsafe-immutable-hash-iterate-next", 2, 2);
+  SCHEME_PRIM_PROC_FLAGS(p) |=
+    scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
+  scheme_add_global_constant ("unsafe-immutable-hash-iterate-next", p, env);
+
+  p = scheme_make_immed_prim(unsafe_scheme_bucket_table_iterate_next,
+			     "unsafe-weak-hash-iterate-next", 2, 2);
+  SCHEME_PRIM_PROC_FLAGS(p) |=
+    scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
+  scheme_add_global_constant ("unsafe-weak-hash-iterate-next", p, env);
+
+  /* unsafe-hash-iterate-key ---------------------------------------- */
+  p = scheme_make_noncm_prim(unsafe_scheme_hash_table_iterate_key,
+			     "unsafe-mutable-hash-iterate-key", 2, 2);
+  SCHEME_PRIM_PROC_FLAGS(p) |=
+    scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE
+				 | SCHEME_PRIM_IS_UNSAFE_OMITABLE);
+  scheme_add_global_constant ("unsafe-mutable-hash-iterate-key", p, env);
+  
+  p = scheme_make_noncm_prim(unsafe_scheme_hash_tree_iterate_key,
+			     "unsafe-immutable-hash-iterate-key", 2, 2);
+  SCHEME_PRIM_PROC_FLAGS(p) |=
+    scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
+				 | SCHEME_PRIM_IS_UNSAFE_NONALLOCATE);
+  scheme_add_global_constant ("unsafe-immutable-hash-iterate-key", p, env);
+  
+  p = scheme_make_noncm_prim(unsafe_scheme_bucket_table_iterate_key,
+			     "unsafe-weak-hash-iterate-key", 2, 2);
+  SCHEME_PRIM_PROC_FLAGS(p) |=
+    scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE
+				 | SCHEME_PRIM_IS_UNSAFE_OMITABLE);
+  scheme_add_global_constant ("unsafe-weak-hash-iterate-key", p, env);
+
+  /* unsafe-hash-iterate-value ---------------------------------------- */
+  p = scheme_make_noncm_prim(unsafe_scheme_hash_table_iterate_value,
+			     "unsafe-mutable-hash-iterate-value", 2, 2);
+  SCHEME_PRIM_PROC_FLAGS(p) |=
+    scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE
+				 | SCHEME_PRIM_IS_UNSAFE_OMITABLE);
+  scheme_add_global_constant ("unsafe-mutable-hash-iterate-value", p, env);
+
+  p = scheme_make_noncm_prim(unsafe_scheme_hash_tree_iterate_value,
+			     "unsafe-immutable-hash-iterate-value", 2, 2);
+  SCHEME_PRIM_PROC_FLAGS(p) |=
+    scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
+				 | SCHEME_PRIM_IS_UNSAFE_NONALLOCATE);
+  scheme_add_global_constant ("unsafe-immutable-hash-iterate-value", p, env);
+
+  p = scheme_make_noncm_prim(unsafe_scheme_bucket_table_iterate_value,
+			     "unsafe-weak-hash-iterate-value", 2, 2);
+  SCHEME_PRIM_PROC_FLAGS(p) |=
+    scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE
+				 | SCHEME_PRIM_IS_UNSAFE_OMITABLE);
+  scheme_add_global_constant ("unsafe-weak-hash-iterate-value", p, env);
+
+  /* unsafe-hash-iterate-key+value ---------------------------------------- */
+  p = scheme_make_prim_w_arity2(unsafe_scheme_hash_table_iterate_key_value,
+				"unsafe-mutable-hash-iterate-key+value", 
+				2, 2, 2, 2);
+  SCHEME_PRIM_PROC_FLAGS(p) |=
+    scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE
+				 | SCHEME_PRIM_IS_UNSAFE_OMITABLE);
+  scheme_add_global_constant ("unsafe-mutable-hash-iterate-key+value", p, env);
+  
+  p = scheme_make_prim_w_arity2(unsafe_scheme_hash_tree_iterate_key_value,
+				"unsafe-immutable-hash-iterate-key+value", 
+				2, 2, 2, 2);
+  SCHEME_PRIM_PROC_FLAGS(p) |=
+    scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
+				 | SCHEME_PRIM_IS_UNSAFE_NONALLOCATE);
+  scheme_add_global_constant ("unsafe-immutable-hash-iterate-key+value", p, env);
+
+  p = scheme_make_prim_w_arity2(unsafe_scheme_bucket_table_iterate_key_value,
+				"unsafe-weak-hash-iterate-key+value", 
+				2, 2, 2, 2);
+  SCHEME_PRIM_PROC_FLAGS(p) |=
+    scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE
+				 | SCHEME_PRIM_IS_UNSAFE_OMITABLE);
+  scheme_add_global_constant ("unsafe-weak-hash-iterate-key+value", p, env);
+
+  /* unsafe-hash-iterate-pair ---------------------------------------- */
+  p = scheme_make_immed_prim(unsafe_scheme_hash_table_iterate_pair,
+			     "unsafe-mutable-hash-iterate-pair", 
+			     2, 2);
+  SCHEME_PRIM_PROC_FLAGS(p) |=
+    scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION
+				 | SCHEME_PRIM_IS_UNSAFE_OMITABLE);
+  scheme_add_global_constant ("unsafe-mutable-hash-iterate-pair", p, env);
+  
+  p = scheme_make_immed_prim(unsafe_scheme_hash_tree_iterate_pair,
+			     "unsafe-immutable-hash-iterate-pair", 
+			     2, 2);
+  SCHEME_PRIM_PROC_FLAGS(p) |=
+    scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
+  scheme_add_global_constant ("unsafe-immutable-hash-iterate-pair", p, env);
+
+  p = scheme_make_immed_prim(unsafe_scheme_bucket_table_iterate_pair,
+			     "unsafe-weak-hash-iterate-pair", 
+			     2, 2);
+  SCHEME_PRIM_PROC_FLAGS(p) |=
+    scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION
+				 | SCHEME_PRIM_IS_UNSAFE_OMITABLE);
+  scheme_add_global_constant ("unsafe-weak-hash-iterate-pair", p, env);
+}
+
 Scheme_Object *scheme_make_pair(Scheme_Object *car, Scheme_Object *cdr)
 {
 #ifdef MZ_PRECISE_GC
@@ -2743,53 +2903,11 @@ static Scheme_Object *hash_table_next(const char *name, mzlonglong start, int ar
     o = SCHEME_CHAPERONE_VAL(o);
 
   if (SCHEME_HASHTP(o)) {
-    Scheme_Hash_Table *hash;
+    return scheme_hash_table_next((Scheme_Hash_Table *)o, start);
-    int i, sz;
-
-    hash = (Scheme_Hash_Table *)o;
-
-    sz = hash->size;
-    if (start >= 0) {
-      if ((start >= sz) || !hash->vals[start])
-        return NULL;
-    }
-    for (i = start + 1; i < sz; i++) {
-      if (hash->vals[i])
-        return scheme_make_integer(i);
-    }
-
-    return scheme_false;
   } else if (SCHEME_HASHTRP(o)) {
-    mzlonglong v;
+    return scheme_hash_tree_next_pos((Scheme_Hash_Tree *)o, start);
-    v = scheme_hash_tree_next((Scheme_Hash_Tree *)o, start);
-    if (v == -1)
-      return scheme_false;
-    else if (v == -2)
-      return NULL;
-    else
-      return scheme_make_integer_value_from_long_long(v);
   } else if (SCHEME_BUCKTP(o)) {
-    Scheme_Bucket_Table *hash;
+    return scheme_bucket_table_next((Scheme_Bucket_Table *)o, start);
-    Scheme_Bucket *bucket;
-    int i, sz;
-
-    hash = (Scheme_Bucket_Table *)o;
-
-    sz = hash->size;
-    
-    if (start >= 0) {
-      bucket = ((start < sz) ? hash->buckets[start] : NULL);
-      if (!bucket || !bucket->val || !bucket->key) 
-        return NULL;      
-    }
-    for (i = start + 1; i < sz; i++) {
-      bucket = hash->buckets[i];
-      if (bucket && bucket->val && bucket->key) {
-        return scheme_make_integer(i);
-      }
-    }
-
-    return scheme_false;
   } else {
     scheme_wrong_contract(name, "hash?", 0, argc, argv);
     return NULL;
@@ -2815,8 +2933,7 @@ Scheme_Object *scheme_hash_table_iterate_next(int argc, Scheme_Object *argv[])
 
   v = hash_table_next("hash-iterate-next", pos, argc, argv);
 
-  if (v)
+  if (v) return v;
-    return v;
 
   if (SCHEME_INTP(p)) {
     if (SCHEME_INT_VAL(p) >= 0)
@@ -2827,12 +2944,12 @@ Scheme_Object *scheme_hash_table_iterate_next(int argc, Scheme_Object *argv[])
   }
 
   if (p)
-    scheme_wrong_contract("hash-iterate-next", "exact-nonnegative-integer?", 1, argc, argv);  
+    scheme_wrong_contract("hash-iterate-next", 
+			  "exact-nonnegative-integer?", 1, argc, argv);  
 
   scheme_contract_error("hash-iterate-next", "no element at index", 
                         "index", 1, argv[1],
                         NULL);
-
   return NULL;
 }
 
@@ -2845,9 +2962,7 @@ static int hash_table_index(const char *name, int argc, Scheme_Object *argv[], S
   if (SCHEME_NP_CHAPERONEP(obj))
     obj = SCHEME_CHAPERONE_VAL(obj);
 
-  if (!scheme_get_long_long_val(p, &pos))
+  if (!scheme_get_long_long_val(p, &pos) || (pos < 0))
-    pos = HASH_POS_TOO_BIG;
-  else if (pos < 0)
     pos = HASH_POS_TOO_BIG;
 
   if (SCHEME_HASHTP(obj)) {
@@ -2899,10 +3014,8 @@ Scheme_Object *scheme_hash_table_iterate_value(int argc, Scheme_Object *argv[])
     Scheme_Object *obj = argv[0];
     if (SCHEME_NP_CHAPERONEP(obj)) {
       Scheme_Object *chap_key, *chap_val;
-      chap_key = chaperone_hash_key(name, obj, key);
+      int ischap = SCHEME_HASHTRP(SCHEME_CHAPERONE_VAL(obj));
-      chap_val = scheme_chaperone_hash_get(obj, chap_key);
+      chaperone_hash_key_value(name, obj, key, &chap_key, &chap_val, ischap);
-      if (!chap_val)
-	no_post_key(name, chap_key, SCHEME_HASHTRP(SCHEME_CHAPERONE_VAL(obj)));
       return chap_val;
     }
     else
@@ -2919,10 +3032,8 @@ Scheme_Object *scheme_hash_table_iterate_pair(int argc, Scheme_Object *argv[])
     Scheme_Object *obj = argv[0];
     if (SCHEME_NP_CHAPERONEP(obj)) {
       Scheme_Object *chap_key, *chap_val;
-      chap_key = chaperone_hash_key(name, obj, key);
+      int ischap = SCHEME_HASHTRP(SCHEME_CHAPERONE_VAL(obj));
-      chap_val = scheme_chaperone_hash_get(obj, chap_key);
+      chaperone_hash_key_value(name, obj, key, &chap_key, &chap_val, ischap);
-      if (!chap_val)
-	no_post_key(name, chap_key, SCHEME_HASHTRP(SCHEME_CHAPERONE_VAL(obj)));
       return scheme_make_pair(chap_key, chap_val);
     }
     else
@@ -2938,13 +3049,8 @@ Scheme_Object *scheme_hash_table_iterate_key_value(int argc, Scheme_Object *argv
   if (hash_table_index(name, argc, argv, &key, &val)) {
     Scheme_Object *res[2], *obj = argv[0];
     if (SCHEME_NP_CHAPERONEP(obj)) {
-      Scheme_Object *chap_key, *chap_val;
+      int ischap = SCHEME_HASHTRP(SCHEME_CHAPERONE_VAL(obj));
-      chap_key = chaperone_hash_key(name, obj, key);
+      chaperone_hash_key_value(name, obj, key, &res[0], &res[1], ischap);
-      chap_val = scheme_chaperone_hash_get(obj, chap_key);
-      if (!chap_val)
-	no_post_key(name, chap_key, SCHEME_HASHTRP(SCHEME_CHAPERONE_VAL(obj)));
-      res[0] = chap_key;
-      res[1] = chap_val;
     }
     else {
       res[0] = key;
@@ -3294,6 +3400,16 @@ static Scheme_Object *chaperone_hash_key(const char *name, Scheme_Object *table,
 {
   return chaperone_hash_op(name, table, key, NULL, 3, scheme_null);
 }
+static void chaperone_hash_key_value(const char *name, Scheme_Object *obj, Scheme_Object *key, Scheme_Object **_chap_key, Scheme_Object **_chap_val, int ischap)
+{
+  Scheme_Object *chap_key, *chap_val;
+  chap_key = chaperone_hash_key(name, obj, key);
+  chap_val = scheme_chaperone_hash_get(obj, chap_key);
+  if (!chap_val)
+    no_post_key(name, chap_key, ischap);
+  *_chap_key = chap_key;
+  *_chap_val = chap_val;
+}
 
 static Scheme_Object *chaperone_hash_clear(const char *name, Scheme_Object *table)
 {
@@ -3878,3 +3994,303 @@ static Scheme_Object *unsafe_set_box (int argc, Scheme_Object *argv[])
     SCHEME_BOX_VAL(argv[0]) = argv[1];
   return scheme_void;
 }
+
+/************************************************************/
+/*               unsafe hash table iteration ops            */
+/************************************************************/
+
+/* unsafe_scheme_hash_table, ie SCHEME_HASHTP, ops */
+Scheme_Object *unsafe_scheme_hash_table_iterate_start(int argc, Scheme_Object *argv[])
+{
+  Scheme_Object *o = argv[0];
+  
+  if (SCHEME_NP_CHAPERONEP(o)) o = SCHEME_CHAPERONE_VAL(o);
+
+  return scheme_hash_table_next((Scheme_Hash_Table *)o, -1);
+}
+Scheme_Object *unsafe_scheme_hash_table_iterate_next(int argc, Scheme_Object *argv[])
+{
+  Scheme_Object *o = argv[0], *res;
+  
+  if (SCHEME_NP_CHAPERONEP(o)) o = SCHEME_CHAPERONE_VAL(o);
+
+  res = scheme_hash_table_next((Scheme_Hash_Table *)o, SCHEME_INT_VAL(argv[1]));
+  
+  if (res)
+    return res;
+  else
+    scheme_contract_error("unsafe-mutable-hash-iterate-next", 
+			  "no element at index", 
+			  "index", 1, argv[1],
+			  NULL);
+  return NULL;
+}
+Scheme_Object *unsafe_scheme_hash_table_iterate_key(int argc, Scheme_Object *argv[])
+{
+  const char *name = "unsafe-mutable-hash-iterate-key";
+  Scheme_Object *obj = argv[0], *key;
+  mzlonglong pos = SCHEME_INT_VAL(argv[1]);
+  
+  if (SCHEME_NP_CHAPERONEP(obj)) {
+    Scheme_Hash_Table *ht = (Scheme_Hash_Table *)SCHEME_CHAPERONE_VAL(obj);
+    if (scheme_hash_table_index(ht, pos, &key, NULL))
+      return chaperone_hash_key(name, obj, key);
+  } else {
+    if(scheme_hash_table_index((Scheme_Hash_Table *)obj, pos, &key, NULL))
+      return key;
+  }
+  scheme_contract_error(name, "no element at index", "index", 1, argv[1], NULL);
+  return NULL;  
+}
+Scheme_Object *unsafe_scheme_hash_table_iterate_value(int argc, Scheme_Object *argv[])
+{
+  const char *name = "unsafe-mutable-hash-iterate-value";
+  Scheme_Object *obj = argv[0], *key, *val;
+  mzlonglong pos = SCHEME_INT_VAL(argv[1]);
+  
+  if (SCHEME_NP_CHAPERONEP(obj)) {
+    Scheme_Object *chap_key, *chap_val;
+    Scheme_Hash_Table *ht = (Scheme_Hash_Table *)SCHEME_CHAPERONE_VAL(obj);
+    if (scheme_hash_table_index(ht, pos, &key, NULL)) {
+      chaperone_hash_key_value(name, obj, key, &chap_key, &chap_val, 0);
+      return chap_val;
+    }
+  } else {
+    if(scheme_hash_table_index((Scheme_Hash_Table *)obj, pos, &key, &val))
+      return val;
+  }
+  scheme_contract_error(name, "no element at index", "index", 1, argv[1], NULL);
+  return NULL;  
+}
+Scheme_Object *unsafe_scheme_hash_table_iterate_pair(int argc, Scheme_Object *argv[])
+{
+  const char *name = "unsafe-mutable-hash-iterate-pair";
+  Scheme_Object *obj = argv[0], *key, *val;
+  mzlonglong pos = SCHEME_INT_VAL(argv[1]);
+
+  if (SCHEME_NP_CHAPERONEP(obj)) {
+    Scheme_Object *chap_key, *chap_val;
+    Scheme_Hash_Table *ht = (Scheme_Hash_Table *)SCHEME_CHAPERONE_VAL(obj);
+    if (scheme_hash_table_index(ht, pos, &key, NULL)) {
+      chaperone_hash_key_value(name, obj, key, &chap_key, &chap_val, 0);
+      return scheme_make_pair(chap_key, chap_val);
+    }
+  } else {
+    if(scheme_hash_table_index((Scheme_Hash_Table *)obj, pos, &key, &val))
+      return scheme_make_pair(key, val);
+  }
+  scheme_contract_error(name, "no element at index", "index", 1, argv[1], NULL);
+  return NULL;  
+}
+Scheme_Object *unsafe_scheme_hash_table_iterate_key_value(int argc, Scheme_Object *argv[])
+{
+  const char *name = "unsafe-mutable-hash-iterate-key+value";
+  Scheme_Object *obj = argv[0], *res[2];
+  mzlonglong pos = SCHEME_INT_VAL(argv[1]);
+
+  if (SCHEME_NP_CHAPERONEP(obj)) {
+    Scheme_Object *key;
+    Scheme_Hash_Table *ht = (Scheme_Hash_Table *)SCHEME_CHAPERONE_VAL(obj);
+    if (scheme_hash_table_index(ht, pos, &key, NULL)) {
+      chaperone_hash_key_value(name, obj, key, &res[0], &res[1], 0);
+      return scheme_values(2, res);
+    }
+  } else {
+    if(scheme_hash_table_index((Scheme_Hash_Table *)obj, pos, &res[0], &res[1]))
+      return scheme_values(2, res);
+  }
+  scheme_contract_error(name, "no element at index", "index", 1, argv[1], NULL);
+  return NULL;  
+}
+
+/* unsafe_scheme_hash_tree, ie SCHEME_HASHTRP, ops */
+Scheme_Object *unsafe_scheme_hash_tree_iterate_start(int argc, Scheme_Object *argv[])
+{
+  Scheme_Object *o = argv[0];
+  
+  if (SCHEME_NP_CHAPERONEP(o)) o = SCHEME_CHAPERONE_VAL(o);
+
+  return scheme_unsafe_hash_tree_start((Scheme_Hash_Tree *)o);
+}
+Scheme_Object *unsafe_scheme_hash_tree_iterate_next(int argc, Scheme_Object *argv[])
+{
+  Scheme_Object *o = argv[0];
+  
+  if (SCHEME_NP_CHAPERONEP(o)) o = SCHEME_CHAPERONE_VAL(o);
+
+  return scheme_unsafe_hash_tree_next(argv[1]);
+}
+Scheme_Object *unsafe_scheme_hash_tree_iterate_key(int argc, Scheme_Object *argv[])
+{
+  Scheme_Object *obj = argv[0], *args = argv[1], *key;
+  Scheme_Hash_Tree *subtree = (Scheme_Hash_Tree *)SCHEME_CAR(args);
+  int i = SCHEME_INT_VAL(SCHEME_CADR(args));
+  key = subtree->els[i];
+  
+  if (SCHEME_NP_CHAPERONEP(obj))
+    return chaperone_hash_key("unsafe-weak-hash-iterate-key", obj, key);
+  else
+    return key;
+}
+Scheme_Object *unsafe_scheme_hash_tree_iterate_value(int argc, Scheme_Object *argv[])
+{
+  Scheme_Object *obj = argv[0], *args = argv[1];
+  Scheme_Hash_Tree *subtree = (Scheme_Hash_Tree *)SCHEME_CAR(args);
+  int i = SCHEME_INT_VAL(SCHEME_CADR(args));
+
+  if (SCHEME_NP_CHAPERONEP(obj)) {
+    Scheme_Object *chap_key, *chap_val;
+    chaperone_hash_key_value("unsafe-weak-hash-iterate-value",
+			     obj, subtree->els[i], &chap_key, &chap_val, 0);
+    return chap_val;
+  } else {
+    int popcount;
+    popcount = hamt_popcount(subtree->bitmap);
+    return subtree->els[i+popcount];
+  }
+}
+Scheme_Object *unsafe_scheme_hash_tree_iterate_pair(int argc, Scheme_Object *argv[])
+{
+  Scheme_Object *obj = argv[0], *args = argv[1];
+  Scheme_Hash_Tree *subtree = (Scheme_Hash_Tree *)SCHEME_CAR(args);
+  int i = SCHEME_INT_VAL(SCHEME_CADR(args));
+  Scheme_Object *key = subtree->els[i];
+
+  if (SCHEME_NP_CHAPERONEP(obj)) {
+    Scheme_Object *chap_key, *chap_val;
+    chaperone_hash_key_value("unsafe-weak-hash-iterate-pair",
+			     obj, subtree->els[i], &chap_key, &chap_val, 0);
+    return scheme_make_pair(chap_key, chap_val);
+  } else {
+    Scheme_Object *val;
+    int popcount;
+    popcount = hamt_popcount(subtree->bitmap);
+    val = subtree->els[i+popcount];
+    return scheme_make_pair(key, val);
+  }
+}
+Scheme_Object *unsafe_scheme_hash_tree_iterate_key_value(int argc, Scheme_Object *argv[])
+{
+  Scheme_Object *obj = argv[0], *args = argv[1], *res[2];
+  Scheme_Hash_Tree *subtree = (Scheme_Hash_Tree *)SCHEME_CAR(args);
+  int i = SCHEME_INT_VAL(SCHEME_CADR(args));
+  Scheme_Object *key = subtree->els[i];
+
+  if (SCHEME_NP_CHAPERONEP(obj)) {
+    chaperone_hash_key_value("unsafe-weak-hash-iterate-pair",
+			     obj, subtree->els[i], &res[0], &res[1], 0);
+  } else {
+    Scheme_Object *val;
+    int popcount;
+    popcount = hamt_popcount(subtree->bitmap);
+    val = subtree->els[i+popcount];
+    res[0] = key;
+    res[1] = val;
+  }
+  return scheme_values(2, res);
+}
+
+/* unsafe_scheme_bucket_table, ie SCHEME_BUCKTP, ops */
+Scheme_Object *unsafe_scheme_bucket_table_iterate_start(int argc, Scheme_Object *argv[])
+{
+  Scheme_Object *o = argv[0];
+  
+  if (SCHEME_NP_CHAPERONEP(o)) o = SCHEME_CHAPERONE_VAL(o);
+
+  return scheme_bucket_table_next((Scheme_Bucket_Table *)o, -1);
+}
+Scheme_Object *unsafe_scheme_bucket_table_iterate_next(int argc, Scheme_Object *argv[])
+{
+  Scheme_Object *o = argv[0], *res;
+
+  if (SCHEME_NP_CHAPERONEP(o)) o = SCHEME_CHAPERONE_VAL(o);
+
+  res = scheme_bucket_table_next((Scheme_Bucket_Table *)o,
+				 SCHEME_INT_VAL(argv[1]));
+  if (res)
+    return res;
+  else
+    scheme_contract_error("unsafe-weak-hash-iterate-next", 
+			  "no element at index", 
+			  "index", 1, argv[1],
+			  NULL);
+  return NULL;
+}
+Scheme_Object *unsafe_scheme_bucket_table_iterate_key(int argc, Scheme_Object *argv[])
+{
+  const char *name = "unsafe-weak-hash-iterate-key";
+  Scheme_Object *obj = argv[0], *key;
+  mzlonglong pos = SCHEME_INT_VAL(argv[1]);
+  
+  if (SCHEME_NP_CHAPERONEP(obj)) {
+    Scheme_Bucket_Table *ht = (Scheme_Bucket_Table *)SCHEME_CHAPERONE_VAL(obj);
+    if (scheme_bucket_table_index(ht, pos, &key, NULL))
+      return chaperone_hash_key(name, obj, key);
+  } else {
+    if(scheme_bucket_table_index((Scheme_Bucket_Table *)obj, pos, &key, NULL))
+      return key;
+  }
+  scheme_contract_error(name, "no element at index", "index", 1, argv[1], NULL);
+  return NULL;  
+}
+Scheme_Object *unsafe_scheme_bucket_table_iterate_value(int argc, Scheme_Object *argv[])
+{
+  const char *name = "unsafe-weak-hash-iterate-value";
+  Scheme_Object *obj = argv[0], *key, *val;
+  mzlonglong pos = SCHEME_INT_VAL(argv[1]);
+  
+  if (SCHEME_NP_CHAPERONEP(obj)) {
+    Scheme_Bucket_Table *ht = (Scheme_Bucket_Table *)SCHEME_CHAPERONE_VAL(obj);
+    Scheme_Object *chap_key, *chap_val;
+    if (scheme_bucket_table_index(ht, pos, &key, NULL)) {
+      chaperone_hash_key_value(name, obj, key, &chap_key, &chap_val, 0);
+      return chap_val;
+    }
+  } else {
+    if(scheme_bucket_table_index((Scheme_Bucket_Table *)obj, pos, &key, &val))
+      return val;
+  }
+  scheme_contract_error(name, "no element at index", "index", 1, argv[1], NULL);
+  return NULL;  
+}
+Scheme_Object *unsafe_scheme_bucket_table_iterate_pair(int argc, Scheme_Object *argv[])
+{
+  const char *name = "unsafe-weak-hash-iterate-pair";
+  Scheme_Object *obj = argv[0], *key, *val;
+  mzlonglong pos = SCHEME_INT_VAL(argv[1]);
+
+  if (SCHEME_NP_CHAPERONEP(obj)) {
+    Scheme_Bucket_Table *ht = (Scheme_Bucket_Table *)SCHEME_CHAPERONE_VAL(obj);
+    Scheme_Object *chap_key, *chap_val;
+    if (scheme_bucket_table_index(ht, pos, &key, NULL)) {
+      chaperone_hash_key_value(name, obj, key, &chap_key, &chap_val, 0);
+      return scheme_make_pair(chap_key, chap_val);
+    }
+  } else {
+    if(scheme_bucket_table_index((Scheme_Bucket_Table *)obj, pos, &key, &val))
+      return scheme_make_pair(key, val);
+  }
+  scheme_contract_error(name, "no element at index", "index", 1, argv[1], NULL);
+  return NULL;  
+}
+Scheme_Object *unsafe_scheme_bucket_table_iterate_key_value(int argc, Scheme_Object *argv[])
+{
+  const char *name = "unsafe-weak-hash-iterate-key+value";
+  Scheme_Object *obj = argv[0], *res[2];
+  mzlonglong pos = SCHEME_INT_VAL(argv[1]);
+
+  if (SCHEME_NP_CHAPERONEP(obj)) {
+    Scheme_Bucket_Table *ht = (Scheme_Bucket_Table *)SCHEME_CHAPERONE_VAL(obj);
+    Scheme_Object *key;
+    if (scheme_bucket_table_index(ht, pos, &key, NULL)) {
+      chaperone_hash_key_value(name, obj, key, &res[0], &res[1], 0);
+      return scheme_values(2, res);
+    }
+  } else {
+    Scheme_Bucket_Table *ht = (Scheme_Bucket_Table *)obj;
+    if(scheme_bucket_table_index(ht, pos, &res[0], &res[1]))
+      return scheme_values(2, res);
+  }
+  scheme_contract_error(name, "no element at index", "index", 1, argv[1], NULL);
+  return NULL;  
+}

racket/src/racket/src/schemef.h

@@ -484,46 +484,6 @@ MZ_EXTERN void scheme_free_immobile_box(void **b);
 MZ_EXTERN Scheme_Object *scheme_add_gc_callback(Scheme_Object *pre, Scheme_Object *post);
 MZ_EXTERN void scheme_remove_gc_callback(Scheme_Object *key);
 
-/*========================================================================*/
-/*                             hash tables                                */
-/*========================================================================*/
-
-MZ_EXTERN Scheme_Bucket_Table *scheme_make_bucket_table(intptr_t size_hint, int type);
-MZ_EXTERN void scheme_add_to_table(Scheme_Bucket_Table *table, const char *key, void *val, int);
-MZ_EXTERN void scheme_change_in_table(Scheme_Bucket_Table *table, const char *key, void *new_val);
-MZ_EXTERN void *scheme_lookup_in_table(Scheme_Bucket_Table *table, const char *key);
-MZ_EXTERN Scheme_Bucket *scheme_bucket_from_table(Scheme_Bucket_Table *table, const char *key);
-MZ_EXTERN int scheme_bucket_table_equal(Scheme_Bucket_Table *t1, Scheme_Bucket_Table *t2);
-MZ_EXTERN Scheme_Bucket_Table *scheme_clone_bucket_table(Scheme_Bucket_Table *bt);
-MZ_EXTERN void scheme_clear_bucket_table(Scheme_Bucket_Table *bt);
-XFORM_NONGCING MZ_EXTERN int scheme_bucket_table_index(Scheme_Bucket_Table *hash, mzlonglong pos, Scheme_Object **_key, Scheme_Object **_val);
-
-MZ_EXTERN Scheme_Hash_Table *scheme_make_hash_table(int type);
-MZ_EXTERN Scheme_Hash_Table *scheme_make_hash_table_equal();
-MZ_EXTERN Scheme_Hash_Table *scheme_make_hash_table_eqv();
-MZ_EXTERN void scheme_hash_set(Scheme_Hash_Table *table, Scheme_Object *key, Scheme_Object *val);
-MZ_EXTERN Scheme_Object *scheme_hash_get(Scheme_Hash_Table *table, Scheme_Object *key);
-XFORM_NONGCING MZ_EXTERN Scheme_Object *scheme_eq_hash_get(Scheme_Hash_Table *table, Scheme_Object *key);
-MZ_EXTERN void scheme_hash_set_atomic(Scheme_Hash_Table *table, Scheme_Object *key, Scheme_Object *val);
-MZ_EXTERN Scheme_Object *scheme_hash_get_atomic(Scheme_Hash_Table *table, Scheme_Object *key);
-MZ_EXTERN int scheme_hash_table_equal(Scheme_Hash_Table *t1, Scheme_Hash_Table *t2);
-MZ_EXTERN int scheme_is_hash_table_equal(Scheme_Object *o);
-MZ_EXTERN int scheme_is_hash_table_eqv(Scheme_Object *o);
-MZ_EXTERN Scheme_Hash_Table *scheme_clone_hash_table(Scheme_Hash_Table *ht);
-MZ_EXTERN void scheme_clear_hash_table(Scheme_Hash_Table *ht);
-XFORM_NONGCING MZ_EXTERN int scheme_hash_table_index(Scheme_Hash_Table *hash, mzlonglong pos, Scheme_Object **_key, Scheme_Object **_val);
-
-MZ_EXTERN Scheme_Hash_Tree *scheme_make_hash_tree(int kind);
-MZ_EXTERN Scheme_Hash_Tree *scheme_make_hash_tree_set(int kind);
-MZ_EXTERN Scheme_Hash_Tree *scheme_hash_tree_set(Scheme_Hash_Tree *tree, Scheme_Object *key, Scheme_Object *val);
-MZ_EXTERN Scheme_Object *scheme_hash_tree_get(Scheme_Hash_Tree *tree, Scheme_Object *key);
-XFORM_NONGCING MZ_EXTERN Scheme_Object *scheme_eq_hash_tree_get(Scheme_Hash_Tree *tree, Scheme_Object *key);
-XFORM_NONGCING MZ_EXTERN mzlonglong scheme_hash_tree_next(Scheme_Hash_Tree *tree, mzlonglong pos);
-XFORM_NONGCING MZ_EXTERN int scheme_hash_tree_index(Scheme_Hash_Tree *tree, mzlonglong pos, Scheme_Object **_key, Scheme_Object **_val);
-MZ_EXTERN int scheme_hash_tree_equal(Scheme_Hash_Tree *t1, Scheme_Hash_Tree *t2);
-MZ_EXTERN int scheme_is_hash_tree_equal(Scheme_Object *o);
-MZ_EXTERN int scheme_is_hash_tree_eqv(Scheme_Object *o);
-
 /*========================================================================*/
 /*                   basic Scheme value constructors                      */
 /*========================================================================*/

racket/src/racket/src/schminc.h

@@ -15,7 +15,7 @@
 #define USE_COMPILED_STARTUP 1
 
 #define EXPECTED_PRIM_COUNT 1144
-#define EXPECTED_UNSAFE_COUNT 108
+#define EXPECTED_UNSAFE_COUNT 126
 #define EXPECTED_FLFXNUM_COUNT 69
 #define EXPECTED_EXTFL_COUNT 45
 #define EXPECTED_FUTURES_COUNT 15

racket/src/racket/src/schpriv.h

@@ -289,6 +289,7 @@ void scheme_init_logger_wait();
 void scheme_init_struct_wait();
 void scheme_init_list(Scheme_Env *env);
 void scheme_init_unsafe_list(Scheme_Env *env);
+void scheme_init_unsafe_hash(Scheme_Env *env);
 void scheme_init_stx(Scheme_Env *env);
 void scheme_init_module(Scheme_Env *env);
 void scheme_init_module_path_table(void);
@@ -589,38 +590,6 @@ extern Scheme_Object *scheme_uint32_ctype;
 extern Scheme_Object *scheme_int64_ctype;
 extern Scheme_Object *scheme_uint64_ctype;
 
-/*========================================================================*/
-/*                    hash functions                                      */
-/*========================================================================*/
-
-Scheme_Object *scheme_make_immutable_hash(int argc, Scheme_Object *argv[]);
-Scheme_Object *scheme_make_immutable_hasheq(int argc, Scheme_Object *argv[]);
-Scheme_Object *scheme_make_immutable_hasheqv(int argc, Scheme_Object *argv[]);
-Scheme_Object *scheme_hash_eq_p(int argc, Scheme_Object *argv[]);
-Scheme_Object *scheme_hash_eqv_p(int argc, Scheme_Object *argv[]);
-Scheme_Object *scheme_hash_equal_p(int argc, Scheme_Object *argv[]);
-Scheme_Object *scheme_hash_table_put(int argc, Scheme_Object *argv[]);
-Scheme_Object *scheme_hash_table_iterate_start(int argc, Scheme_Object *argv[]);
-Scheme_Object *scheme_hash_table_iterate_next(int argc, Scheme_Object *argv[]);
-Scheme_Object *scheme_hash_table_iterate_value(int argc, Scheme_Object *argv[]);
-Scheme_Object *scheme_hash_table_iterate_key(int argc, Scheme_Object *argv[]);
-
-Scheme_Object *scheme_hash_get_w_key_wraps(Scheme_Hash_Table *table, Scheme_Object *key,
-                                           Scheme_Object *key_wraps);
-void scheme_hash_set_w_key_wraps(Scheme_Hash_Table *table, Scheme_Object *key, Scheme_Object *val,
-                                 Scheme_Object *key_wraps);
-Scheme_Bucket *scheme_bucket_or_null_from_table_w_key_wraps(Scheme_Bucket_Table *table,
-                                                            const char *key, int add,
-                                                            Scheme_Object *key_wraps);
-void scheme_add_to_table_w_key_wraps(Scheme_Bucket_Table *table, const char *key, void *val, 
-                                     int constant, Scheme_Object *key_wraps);
-void *scheme_lookup_in_table_w_key_wraps(Scheme_Bucket_Table *table, const char *key,
-                                         Scheme_Object *key_wraps);
-Scheme_Object *scheme_hash_tree_get_w_key_wraps(Scheme_Hash_Tree *tree, Scheme_Object *key,
-                                                Scheme_Object *key_wraps);
-Scheme_Hash_Tree *scheme_hash_tree_set_w_key_wraps(Scheme_Hash_Tree *tree, Scheme_Object *key, Scheme_Object *val,
-                                                   Scheme_Object *key_wraps);
-
 /*========================================================================*/
 /*                    thread state and maintenance                        */
 /*========================================================================*/
@@ -927,6 +896,85 @@ struct Scheme_Hash_Tree {
 Scheme_Object *scheme_intern_literal_string(Scheme_Object *str);
 Scheme_Object *scheme_intern_literal_number(Scheme_Object *num);
 
+/*========================================================================*/
+/*                    hash functions                                      */
+/*========================================================================*/
+
+Scheme_Object *scheme_make_immutable_hash(int argc, Scheme_Object *argv[]);
+Scheme_Object *scheme_make_immutable_hasheq(int argc, Scheme_Object *argv[]);
+Scheme_Object *scheme_make_immutable_hasheqv(int argc, Scheme_Object *argv[]);
+Scheme_Object *scheme_hash_eq_p(int argc, Scheme_Object *argv[]);
+Scheme_Object *scheme_hash_eqv_p(int argc, Scheme_Object *argv[]);
+Scheme_Object *scheme_hash_equal_p(int argc, Scheme_Object *argv[]);
+Scheme_Object *scheme_hash_table_put(int argc, Scheme_Object *argv[]);
+Scheme_Object *scheme_hash_table_iterate_start(int argc, Scheme_Object *argv[]);
+Scheme_Object *scheme_hash_table_iterate_next(int argc, Scheme_Object *argv[]);
+Scheme_Object *scheme_hash_table_iterate_value(int argc, Scheme_Object *argv[]);
+Scheme_Object *scheme_hash_table_iterate_key(int argc, Scheme_Object *argv[]);
+
+Scheme_Object *scheme_hash_get_w_key_wraps(Scheme_Hash_Table *table, Scheme_Object *key,
+                                           Scheme_Object *key_wraps);
+void scheme_hash_set_w_key_wraps(Scheme_Hash_Table *table, Scheme_Object *key, Scheme_Object *val,
+                                 Scheme_Object *key_wraps);
+Scheme_Bucket *scheme_bucket_or_null_from_table_w_key_wraps(Scheme_Bucket_Table *table,
+                                                            const char *key, int add,
+                                                            Scheme_Object *key_wraps);
+void scheme_add_to_table_w_key_wraps(Scheme_Bucket_Table *table, const char *key, void *val, 
+                                     int constant, Scheme_Object *key_wraps);
+void *scheme_lookup_in_table_w_key_wraps(Scheme_Bucket_Table *table, const char *key,
+                                         Scheme_Object *key_wraps);
+Scheme_Object *scheme_hash_tree_get_w_key_wraps(Scheme_Hash_Tree *tree, Scheme_Object *key,
+                                                Scheme_Object *key_wraps);
+Scheme_Hash_Tree *scheme_hash_tree_set_w_key_wraps(Scheme_Hash_Tree *tree, Scheme_Object *key, Scheme_Object *val,
+                                                   Scheme_Object *key_wraps);
+
+/*========================================================================*/
+/*                             hash tables                                */
+/*========================================================================*/
+
+Scheme_Bucket_Table *scheme_make_bucket_table(intptr_t size_hint, int type);
+void scheme_add_to_table(Scheme_Bucket_Table *table, const char *key, void *val, int);
+void scheme_change_in_table(Scheme_Bucket_Table *table, const char *key, void *new_val);
+void *scheme_lookup_in_table(Scheme_Bucket_Table *table, const char *key);
+Scheme_Bucket *scheme_bucket_from_table(Scheme_Bucket_Table *table, const char *key);
+int scheme_bucket_table_equal(Scheme_Bucket_Table *t1, Scheme_Bucket_Table *t2);
+Scheme_Bucket_Table *scheme_clone_bucket_table(Scheme_Bucket_Table *bt);
+void scheme_clear_bucket_table(Scheme_Bucket_Table *bt);
+Scheme_Object *scheme_bucket_table_next(Scheme_Bucket_Table *hash, mzlonglong start);
+XFORM_NONGCING int scheme_bucket_table_index(Scheme_Bucket_Table *hash, mzlonglong pos, Scheme_Object **_key, Scheme_Object **_val);
+
+Scheme_Hash_Table *scheme_make_hash_table(int type);
+Scheme_Hash_Table *scheme_make_hash_table_equal();
+Scheme_Hash_Table *scheme_make_hash_table_eqv();
+void scheme_hash_set(Scheme_Hash_Table *table, Scheme_Object *key, Scheme_Object *val);
+Scheme_Object *scheme_hash_get(Scheme_Hash_Table *table, Scheme_Object *key);
+XFORM_NONGCING Scheme_Object *scheme_eq_hash_get(Scheme_Hash_Table *table, Scheme_Object *key);
+void scheme_hash_set_atomic(Scheme_Hash_Table *table, Scheme_Object *key, Scheme_Object *val);
+Scheme_Object *scheme_hash_get_atomic(Scheme_Hash_Table *table, Scheme_Object *key);
+int scheme_hash_table_equal(Scheme_Hash_Table *t1, Scheme_Hash_Table *t2);
+int scheme_is_hash_table_equal(Scheme_Object *o);
+int scheme_is_hash_table_eqv(Scheme_Object *o);
+Scheme_Hash_Table *scheme_clone_hash_table(Scheme_Hash_Table *ht);
+void scheme_clear_hash_table(Scheme_Hash_Table *ht);
+Scheme_Object *scheme_hash_table_next(Scheme_Hash_Table *hash, mzlonglong start);
+XFORM_NONGCING int scheme_hash_table_index(Scheme_Hash_Table *hash, mzlonglong pos, Scheme_Object **_key, Scheme_Object **_val);
+
+Scheme_Hash_Tree *scheme_make_hash_tree(int kind);
+Scheme_Hash_Tree *scheme_make_hash_tree_set(int kind);
+Scheme_Hash_Tree *scheme_hash_tree_set(Scheme_Hash_Tree *tree, Scheme_Object *key, Scheme_Object *val);
+Scheme_Object *scheme_hash_tree_get(Scheme_Hash_Tree *tree, Scheme_Object *key);
+XFORM_NONGCING Scheme_Object *scheme_eq_hash_tree_get(Scheme_Hash_Tree *tree, Scheme_Object *key);
+XFORM_NONGCING mzlonglong scheme_hash_tree_next(Scheme_Hash_Tree *tree, mzlonglong pos);
+Scheme_Object *scheme_unsafe_hash_tree_start(Scheme_Hash_Tree *ht);
+Scheme_Object *scheme_unsafe_hash_tree_next(Scheme_Object *args);
+Scheme_Object *scheme_hash_tree_next_pos(Scheme_Hash_Tree *tree, mzlonglong pos);
+XFORM_NONGCING int scheme_hash_tree_index(Scheme_Hash_Tree *tree, mzlonglong pos, Scheme_Object **_key, Scheme_Object **_val);
+int scheme_hash_tree_equal(Scheme_Hash_Tree *t1, Scheme_Hash_Tree *t2);
+int scheme_is_hash_tree_equal(Scheme_Object *o);
+int scheme_is_hash_tree_eqv(Scheme_Object *o);
+
+XFORM_NONGCING int hamt_popcount(hash_tree_bitmap_t x);
+
 /*========================================================================*/
 /*                              structs                                   */
 /*========================================================================*/

racket/src/racket/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "6.4.0.5"
+#define MZSCHEME_VERSION "6.4.0.6"
 
 #define MZSCHEME_VERSION_X 6
 #define MZSCHEME_VERSION_Y 4
 #define MZSCHEME_VERSION_Z 0
-#define MZSCHEME_VERSION_W 5
+#define MZSCHEME_VERSION_W 6
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)