add hash-iterate-pair and hash-iterate-key+value

- cuts in-hash and in-hash-pairs iteration time in half
- refactor hash_table_index
- add tests
- bump version

closes #1224

pkgs/base/info.rkt

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

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

@@ -485,6 +485,26 @@ Returns the value for the element in @racket[hash] at index
 @racket[pos]. If @racket[pos] is not a valid index for
 @racket[hash], the @exnraise[exn:fail:contract].}
 
+@defproc[(hash-iterate-pair [hash hash?]
+                           [pos exact-nonnegative-integer?])
+         (cons any any)]{
+
+Returns a pair containing the key and value for the element 
+in @racket[hash] at index
+@racket[pos]. If @racket[pos] is not a valid index for
+@racket[hash], the @exnraise[exn:fail:contract].}
+
+@history[#:added "6.4.0.5"]
+
+@defproc[(hash-iterate-key+value [hash hash?]
+                           [pos exact-nonnegative-integer?])
+         (values any any)]{
+
+Returns the key and value for the element in @racket[hash] at index
+@racket[pos]. If @racket[pos] is not a valid index for
+@racket[hash], the @exnraise[exn:fail:contract].}
+
+@history[#:added "6.4.0.5"]
 
 @defproc[(hash-copy [hash hash?]) 
          (and/c hash? (not/c immutable?))]{

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

@@ -34,3 +34,91 @@
         (hash-copy
          #hash([one . 1] [two . 2] [three . 3] [four . 4]))
         h))
+
+(let ()
+  (define lst1 (build-list 10 values))
+  (define lst2 (build-list 10 add1))
+  (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 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) 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 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 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) 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 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 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) 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 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 ht/immut-vals/seq]) v)
+        (for/sum ([v ht/mut-vals/seq]) v)
+        (for/sum ([v ht/weak-vals/seq]) v)))

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

@@ -23,7 +23,7 @@
 
 The test form has these two shapes:
 
-  (test <expected> <procdure> <argument1> <argument2> ...)
+  (test <expected> <procedure> <argument1> <argument2> ...)
 
   (test <expected> <symbolic-name> <expression>)
 

racket/collects/racket/private/for.rkt

@@ -660,10 +660,7 @@
     (unless (hash? ht) (raise-argument-error 'in-hash "hash?" ht))
     (make-do-sequence (lambda () (:hash-key+val-gen ht))))
 
-  (define (:hash-key+val-gen ht)
+  (define (:hash-key+val-gen ht) (:hash-gen ht hash-iterate-key+value))
-    (:hash-gen ht (lambda (ht pos)
-                    (values (hash-iterate-key ht pos)
-                            (hash-iterate-value ht pos)))))
 
   (define-sequence-syntax *in-hash
     (lambda () #'in-hash)
@@ -682,8 +679,7 @@
               ;; pos check
               i
               ;; inner bindings
-              ([(k v) (values (hash-iterate-key ht i)
+              ([(k v) (hash-iterate-key+value ht i)])
-                              (hash-iterate-value ht i))])
               ;; pre guard
               #t
               ;; post guard
@@ -754,10 +750,7 @@
 
   (define (in-hash-pairs ht)
     (unless (hash? ht) (raise-argument-error 'in-hash-values "hash?" ht))
-    (make-do-sequence (lambda ()
+    (make-do-sequence (lambda () (:hash-gen ht hash-iterate-pair))))
-                        (:hash-gen ht (lambda (ht pos)
-                                        (cons (hash-iterate-key ht pos)
-                                              (hash-iterate-value ht pos)))))))
 
   (define-sequence-syntax *in-hash-pairs
     (lambda () #'in-hash-pairs)
@@ -776,8 +769,7 @@
               ;; pos check
               i
               ;; inner bindings
-              ([(id) (cons (hash-iterate-key ht i)
+              ([(id) (hash-iterate-pair ht i)])
-                           (hash-iterate-value ht i))])
               ;; pre guard
               #t
               ;; post guard

racket/src/racket/src/hash.c

@@ -657,6 +657,20 @@ 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)
+{
+  if (pos < hash->size) {
+    if (hash->vals[pos]) {
+      *_key = hash->keys[pos];
+      if (_val)
+	*_val = hash->vals[pos];
+      return 1;
+    }
+  }
+  
+  return 0;
+}
+
 /*========================================================================*/
 /*                  old-style hash table, with buckets                    */
 /*========================================================================*/
@@ -1103,6 +1117,26 @@ Scheme_Bucket_Table *scheme_clone_bucket_table(Scheme_Bucket_Table *bt)
   return table;
 }
 
+int scheme_bucket_table_index(Scheme_Bucket_Table *hash, mzlonglong pos, Scheme_Object **_key, Scheme_Object **_val)
+{
+  Scheme_Bucket *bucket;
+
+  if (pos < hash->size) {
+    bucket = hash->buckets[pos];
+    if (bucket && bucket->val && bucket->key) {
+      if (hash->weak)
+	*_key = (Scheme_Object *)HT_EXTRACT_WEAK(bucket->key);
+      else
+	*_key = (Scheme_Object *)bucket->key;
+      if (_val)
+	*_val = (Scheme_Object *)bucket->val;
+      return 1;
+    }
+  }
+  
+  return 0;
+}
+
 /*========================================================================*/
 /*                         precise GC hashing                             */
 /*========================================================================*/

racket/src/racket/src/list.c

@@ -131,8 +131,10 @@ static Scheme_Object *hash_table_map(int argc, Scheme_Object *argv[]);
 static Scheme_Object *hash_table_for_each(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_table_iterate_value(int argc, Scheme_Object *argv[]);
+Scheme_Object *scheme_hash_table_iterate_pair(int argc, Scheme_Object *argv[]);
+Scheme_Object *scheme_hash_table_iterate_key_value(int argc, Scheme_Object *argv[]);
 static Scheme_Object *eq_hash_code(int argc, Scheme_Object *argv[]);
 static Scheme_Object *equal_hash_code(int argc, Scheme_Object *argv[]);
 static Scheme_Object *equal_hash2_code(int argc, Scheme_Object *argv[]);
@@ -632,6 +634,16 @@ scheme_init_list (Scheme_Env *env)
 						    "hash-iterate-key",
                                                     2, 2),
 			     env);
+  scheme_add_global_constant("hash-iterate-pair",
+			     scheme_make_immed_prim(scheme_hash_table_iterate_pair,
+						    "hash-iterate-pair",
+                                                    2, 2),
+			     env);
+  scheme_add_global_constant("hash-iterate-key+value",
+			     scheme_make_prim_w_arity2(scheme_hash_table_iterate_key_value,
+						    "hash-iterate-key+value",
+                                                    2, 2, 2, 2),
+			     env);
 
   scheme_add_global_constant("chaperone-hash",
                              scheme_make_prim_w_arity(chaperone_hash,
@@ -2824,18 +2836,14 @@ Scheme_Object *scheme_hash_table_iterate_next(int argc, Scheme_Object *argv[])
   return NULL;
 }
 
-static Scheme_Object *hash_table_index(const char *name, int argc, Scheme_Object *argv[], int get_val)
+static Scheme_Object *hash_table_index(const char *name, int argc, Scheme_Object *argv[], Scheme_Object **_k, Scheme_Object **_v)
 {
-  Scheme_Object *p = argv[1], *obj, *chaperone, *key;
+  Scheme_Object *p = argv[1], *obj = argv[0];
   mzlonglong pos;
-  intptr_t sz;
+  int res;
 
-  obj = argv[0];
+  if (SCHEME_NP_CHAPERONEP(obj))
-  if (SCHEME_NP_CHAPERONEP(obj)) {
+    obj = SCHEME_CHAPERONE_VAL(obj);
-    chaperone = obj;
-    obj = SCHEME_CHAPERONE_VAL(chaperone);
-  } else
-    chaperone = NULL;
 
   if (!scheme_get_long_long_val(p, &pos))
     pos = HASH_POS_TOO_BIG;
@@ -2843,79 +2851,18 @@ static Scheme_Object *hash_table_index(const char *name, int argc, Scheme_Object
     pos = HASH_POS_TOO_BIG;
 
   if (SCHEME_HASHTP(obj)) {
-    Scheme_Hash_Table *hash;
+    res = scheme_hash_table_index((Scheme_Hash_Table *)obj, pos, _k, _v);
-
-    hash = (Scheme_Hash_Table *)obj;
-
-    sz = hash->size;
-    if (pos < sz) {
-      if (hash->vals[pos]) {
-        if (chaperone) {
-          if (get_val) {
-            key = chaperone_hash_key(name, chaperone, hash->keys[pos]);
-            obj = scheme_chaperone_hash_get(chaperone, key);
-            if (!obj)
-              no_post_key("hash-iterate-value", key, 0);
-            return obj;
-          } else
-            return chaperone_hash_key(name, chaperone, hash->keys[pos]);
-        } else if (get_val)
-          return hash->vals[pos];
-        else
-          return hash->keys[pos];
-      }
-    }
   } else if (SCHEME_HASHTRP(obj)) {
-    Scheme_Object *v, *k;
+    res = scheme_hash_tree_index((Scheme_Hash_Tree *)obj, pos, _k, _v);
-    if (scheme_hash_tree_index((Scheme_Hash_Tree *)obj, pos, &k, &v)) {
-      if (chaperone) {
-        if (get_val) {
-          key = chaperone_hash_key(name, chaperone, k);
-          obj = scheme_chaperone_hash_get(chaperone, key);
-          if (!obj)
-            no_post_key("hash-iterate-value", key, 1);
-          return obj;
-        } else
-          return chaperone_hash_key(name, chaperone, k);
-      } else
-        return (get_val ? v : k);
-    }
   } else if (SCHEME_BUCKTP(obj)) {
-    Scheme_Bucket_Table *hash;
+    res = scheme_bucket_table_index((Scheme_Bucket_Table *)obj, pos, _k, _v);
-    Scheme_Bucket *bucket;
-
-    hash = (Scheme_Bucket_Table *)obj;
-
-    sz = hash->size;
-    if (pos < sz) {
-      bucket = hash->buckets[pos];
-      if (bucket && bucket->val && bucket->key) {
-        if (get_val && !chaperone)
-          return (Scheme_Object *)bucket->val;
-        else {
-          if (hash->weak)
-            obj = (Scheme_Object *)HT_EXTRACT_WEAK(bucket->key);
-          else
-            obj = (Scheme_Object *)bucket->key;
-          if (chaperone) {
-            if (get_val) {
-              key = chaperone_hash_key(name, chaperone, obj);
-              obj = scheme_chaperone_hash_get(chaperone, key);
-              if (!obj)
-                no_post_key("hash-iterate-value", key, 0);
-              return obj;
-            } else
-              return chaperone_hash_key(name, chaperone, obj);
-          } else
-            return obj;
-        }
-      }
-    }
   } else {
     scheme_wrong_contract(name, "hash?", 0, argc, argv);
-    return NULL;
+    return 0;
   }
 
+  if (res) return 1;
+
   if ((SCHEME_INTP(p)
        && (SCHEME_INT_VAL(p) >= 0))
       || (SCHEME_BIGNUMP(p)
@@ -2923,21 +2870,89 @@ static Scheme_Object *hash_table_index(const char *name, int argc, Scheme_Object
     scheme_contract_error(name, "no element at index",
                           "index", 1, p,
                           NULL);
-    return NULL;
+    return 0;
   }
 
   scheme_wrong_contract(name, "exact-nonnegative-integer?", 1, argc, argv);  
+  return 0;
+}
+
+Scheme_Object *scheme_hash_table_iterate_key(int argc, Scheme_Object *argv[])
+{
+  const char *name = "hash-iterate-key";
+  Scheme_Object *key;
+  if (hash_table_index(name, argc, argv, &key, NULL)) {
+    Scheme_Object *obj = argv[0];
+    if (SCHEME_NP_CHAPERONEP(obj))
+      return chaperone_hash_key(name, obj, key);
+    else
+      return key;
+  }
   return NULL;
 }
 
 Scheme_Object *scheme_hash_table_iterate_value(int argc, Scheme_Object *argv[])
 {
-  return hash_table_index("hash-iterate-value", argc, argv, 1);
+  const char *name = "hash-iterate-value";
+  Scheme_Object *key, *val;
+  if (hash_table_index(name, argc, argv, &key, &val)) {
+    Scheme_Object *obj = argv[0];
+    if (SCHEME_NP_CHAPERONEP(obj)) {
+      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, SCHEME_HASHTRP(SCHEME_CHAPERONE_VAL(obj)));
+      return chap_val;
+    }
+    else
+      return val;
+  }
+  return NULL;
 }
 
-Scheme_Object *scheme_hash_table_iterate_key(int argc, Scheme_Object *argv[])
+Scheme_Object *scheme_hash_table_iterate_pair(int argc, Scheme_Object *argv[])
 {
-  return hash_table_index("hash-iterate-key", argc, argv, 0);
+  const char *name = "hash-iterate-pair";
+  Scheme_Object *key, *val;
+  if (hash_table_index(name, argc, argv, &key, &val)) {
+    Scheme_Object *obj = argv[0];
+    if (SCHEME_NP_CHAPERONEP(obj)) {
+      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, SCHEME_HASHTRP(SCHEME_CHAPERONE_VAL(obj)));
+      return scheme_make_pair(chap_key, chap_val);
+    }
+    else
+      return scheme_make_pair(key, val);
+  }
+  return NULL;
+}
+
+Scheme_Object *scheme_hash_table_iterate_key_value(int argc, Scheme_Object *argv[])
+{
+  const char *name = "hash-iterate-key+value";
+  Scheme_Object *key, *val;
+  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;
+      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, SCHEME_HASHTRP(SCHEME_CHAPERONE_VAL(obj)));
+      res[0] = chap_key;
+      res[1] = chap_val;
+    }
+    else {
+      res[0] = key;
+      res[1] = val;
+    }
+    return scheme_values(2, res);
+  }
+  return NULL;
 }
 
 static Scheme_Object *do_chaperone_hash(const char *name, int is_impersonator, int argc, Scheme_Object **argv)

racket/src/racket/src/schemef.h

@@ -496,6 +496,7 @@ MZ_EXTERN Scheme_Bucket *scheme_bucket_from_table(Scheme_Bucket_Table *table, co
 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();
@@ -510,6 +511,7 @@ 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);

racket/src/racket/src/schminc.h

@@ -14,7 +14,7 @@
 
 #define USE_COMPILED_STARTUP 1
 
-#define EXPECTED_PRIM_COUNT 1142
+#define EXPECTED_PRIM_COUNT 1144
 #define EXPECTED_UNSAFE_COUNT 108
 #define EXPECTED_FLFXNUM_COUNT 69
 #define EXPECTED_EXTFL_COUNT 45

racket/src/racket/src/schvers.h

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