committing @mflatt hashtable-cells pull request

original commit: 1900a7ef534366a4311a714cf56b9c60657ba0a1

LOG

@@ -1056,3 +1056,8 @@
     cmacros.ss, cpnanopass.ss,
     gc.c,
     7.ms
+- add hashtable-cells and add a size argument to hashtable-keys,
+  hashtable-values, and hashtable-entries
+    newhash.ss, primdata.ss,
+    hash.ms, root-experr*, patch*,
+    objects.stex, release_notes.stex

csug/objects.stex

@@ -1841,9 +1841,36 @@ cell ;=> (#(a b c) . 3)
 (hashtable-ref ht v 0) ;=> 4
 \endschemedisplay
 
+%----------------------------------------------------------------------------
+\entryheader
+\formdef{hashtable-keys}{\categoryprocedure}{(hashtable-keys \var{hashtable})}
+\formdef{hashtable-keys}{\categoryprocedure}{(hashtable-keys \var{hashtable} \var{size})}
+\returns a vector containing the keys in \var{hashtable}
+\listlibraries
+\endentryheader
+
+\noindent
+Identitcal to the Revised$^6$ Report counterpart, but allowing an optional
+\var{size} argument.
+If \var{size} is specified, then it must be an exact, nonnegative integer, and the
+result vector contains no more than \var{size} elements.
+Different calls to \scheme{hashtable-keys}
+with a \var{size} less than \scheme{(hashtable-size \var{hashtable})}
+may return different subsets of \var{hashtable}'s keys.
+
+\schemedisplay
+(define ht (make-eq-hashtable))
+(hashtable-set! ht 'a "one")
+(hashtable-set! ht 'b "two")
+(hashtable-set! ht 'c "three")
+(hashtable-keys ht) ;=> #(a b c) \var{or any permutation}
+(hashtable-keys ht 1) ;=> #(a) \var{or} #(b) \var{or} #(c)
+\endschemedisplay
+
 %----------------------------------------------------------------------------
 \entryheader
 \formdef{hashtable-values}{\categoryprocedure}{(hashtable-values \var{hashtable})}
+\formdef{hashtable-values}{\categoryprocedure}{(hashtable-values \var{hashtable} \var{size})}
 \returns a vector containing the values in \var{hashtable}
 \listlibraries
 \endentryheader
@@ -1852,6 +1879,11 @@ cell ;=> (#(a b c) . 3)
 Each value is the value of one of the keys in \var{hashtable}.
 Duplicate values are not removed.
 The values may appear in any order in the returned vector.
+If \var{size} is specified, then it must be an exact, nonnegative integer, and the
+result vector contains no more than \var{size} elements.
+Different calls to \scheme{hashtable-values}
+with a \var{size} less than \scheme{(hashtable-size \var{hashtable})}
+may return different subsets of \var{hashtable}'s values.
 
 \schemedisplay
 (define ht (make-eq-hashtable))
@@ -1860,19 +1892,65 @@ The values may appear in any order in the returned vector.
 (hashtable-set! ht p1 "one")
 (hashtable-set! ht p2 "two")
 (hashtable-set! ht 'q "two")
-(hashtable-values ht) ;=> #("one" "two" "two")
+(hashtable-values ht) ;=> #("one" "two" "two") \var{or any permutation}
+(hashtable-values ht 1) ;=> #("one") \var{or} #("two")
 \endschemedisplay
 
-This procedure is equivalent to:
+This procedure is equivalent to calling \scheme{hashtable-entries} and returning only
+the second result, but it is more efficient since the separate vector of keys need
+not be created.
+
+%----------------------------------------------------------------------------
+\entryheader
+\formdef{hashtable-entries}{\categoryprocedure}{(hashtable-entries \var{hashtable})}
+\formdef{hashtable-entries}{\categoryprocedure}{(hashtable-entries \var{hashtable} \var{size})}
+\returns two vectors containing the keys and values in \var{hashtable}
+\listlibraries
+\endentryheader
+
+\noindent
+Identitcal to the Revised$^6$ Report counterpart, but allowing an optional
+\var{size} argument.
+If \var{size} is specified, then it must be an exact, nonnegative integer, and the
+result vectors contain no more than \var{size} elements.
+Different calls to \scheme{hashtable-entries}
+with a \var{size} less than \scheme{(hashtable-size \var{hashtable})}
+may return different subsets of \var{hashtable}'s entries.
 
 \schemedisplay
-(lambda (ht)
+(define ht (make-eq-hashtable))
-  (let-values ([(keys values) (hashtable-entries ht)])
+(hashtable-set! ht 'a "one")
-    values))
+(hashtable-set! ht 'b "two")
+(hashtable-entries ht) ;=> #(a b) #("one" "two") \var{or the other permutation}
+(hashtable-entries ht 1) ;=> #(a) #("one") \var{or} #(b) #("two") 
 \endschemedisplay
 
-but more efficient since the separate vector of keys need
+%----------------------------------------------------------------------------
-not be created.
+\entryheader
+\formdef{hashtable-cells}{\categoryprocedure}{(hashtable-cells \var{hashtable})}
+\formdef{hashtable-cells}{\categoryprocedure}{(hashtable-cells \var{hashtable} \var{size})}
+\returns a vector of up to \var{size} elements containing the cells of \var{hashtable}
+\listlibraries
+\endentryheader
+
+\noindent
+Each element of the result vector is the value of one of the cells in \var{hashtable}.
+The cells may appear in any order in the returned vector.
+If \var{size} is specified, then it must be an exact, nonnegative integer, and the
+result vector contains no more than \var{size} cells.
+If \var{size} is not specified, then the result vector has \scheme{(hashtable-size \var{hashtable})} elements.
+Different calls to \scheme{hashtable-cells}
+with a \var{size} less than \scheme{(hashtable-size \var{hashtable})}
+may return different subsets of \var{hashtable}'s cells.
+
+\schemedisplay
+(define ht (make-eqv-hashtable))
+(hashtable-set! ht 1 'one)
+(hashtable-set! ht 2 'two)
+(hashtable-cells ht) ;=> #((1 . one) (2 . two)) \var{or} #((2 . two) (1 . one))
+(hashtable-cells ht 1) ;=> #((1 . one)) \var{or} #((2 . two))
+(hashtable-cells ht 0) ;=> #()
+\endschemedisplay
 
 %----------------------------------------------------------------------------
 \entryheader

mats/patch-compile-0-t-f-f

@@ -4382,14 +4382,31 @@
   hash.mo:Expected error in mat hashtable-arguments: "hashtable-clear!: #<eq hashtable> is not mutable".
   hash.mo:Expected error in mat hashtable-arguments: "hashtable-clear!: invalid size argument #t".
 ! hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-keys)".
+! hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-keys $ht 72 43)".
+  hash.mo:Expected error in mat hashtable-arguments: "hashtable-keys: (hash . table) is not a hashtable".
+  hash.mo:Expected error in mat hashtable-arguments: "hashtable-keys: -79 is not a valid length".
+  hash.mo:Expected error in mat hashtable-arguments: "hashtable-keys: not-an-unsigned-integer is not a valid length".
+! hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-keys)".
 ! hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-keys $ht 72)".
   hash.mo:Expected error in mat hashtable-arguments: "hashtable-keys: (hash . table) is not a hashtable".
 ! hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-values)".
-! hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-values $ht 72)".
+! hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-values $ht 72 43)".
   hash.mo:Expected error in mat hashtable-arguments: "hashtable-values: (hash . table) is not a hashtable".
+  hash.mo:Expected error in mat hashtable-arguments: "hashtable-values: -79 is not a valid length".
+  hash.mo:Expected error in mat hashtable-arguments: "hashtable-values: not-an-unsigned-integer is not a valid length".
+! hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-entries)".
+! hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-entries $ht 72 43)".
+  hash.mo:Expected error in mat hashtable-arguments: "hashtable-entries: (hash . table) is not a hashtable".
+  hash.mo:Expected error in mat hashtable-arguments: "hashtable-entries: -79 is not a valid length".
+  hash.mo:Expected error in mat hashtable-arguments: "hashtable-entries: not-an-unsigned-integer is not a valid length".
 ! hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-entries)".
 ! hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-entries $ht 72)".
   hash.mo:Expected error in mat hashtable-arguments: "hashtable-entries: (hash . table) is not a hashtable".
+! hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-cells)".
+! hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-cells $ht 72 43)".
+  hash.mo:Expected error in mat hashtable-arguments: "hashtable-cells: (hash . table) is not a hashtable".
+  hash.mo:Expected error in mat hashtable-arguments: "hashtable-cells: -79 is not a valid length".
+  hash.mo:Expected error in mat hashtable-arguments: "hashtable-cells: not-an-unsigned-integer is not a valid length".
 ! hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-hash-function)".
 ! hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-hash-function $ht $ht)".
   hash.mo:Expected error in mat hashtable-arguments: "hashtable-hash-function: (hash . table) is not an eq hashtable".
@@ -4477,14 +4494,31 @@
   hash.mo:Expected error in mat hashtable-arguments: "hashtable-clear!: #<eq hashtable> is not mutable".
   hash.mo:Expected error in mat hashtable-arguments: "hashtable-clear!: invalid size argument #t".
 ! hash.mo:Expected error in mat hashtable-arguments: "incorrect number of arguments to #<procedure hashtable-keys>".
+! hash.mo:Expected error in mat hashtable-arguments: "incorrect number of arguments to #<procedure hashtable-keys>".
+  hash.mo:Expected error in mat hashtable-arguments: "hashtable-keys: (hash . table) is not a hashtable".
+  hash.mo:Expected error in mat hashtable-arguments: "hashtable-keys: -79 is not a valid length".
+  hash.mo:Expected error in mat hashtable-arguments: "hashtable-keys: not-an-unsigned-integer is not a valid length".
+! hash.mo:Expected error in mat hashtable-arguments: "incorrect number of arguments to #<procedure hashtable-keys>".
 ! hash.mo:Expected error in mat hashtable-arguments: "incorrect number of arguments to #<procedure hashtable-keys>".
   hash.mo:Expected error in mat hashtable-arguments: "hashtable-keys: (hash . table) is not a hashtable".
 ! hash.mo:Expected error in mat hashtable-arguments: "incorrect number of arguments to #<procedure hashtable-values>".
 ! hash.mo:Expected error in mat hashtable-arguments: "incorrect number of arguments to #<procedure hashtable-values>".
   hash.mo:Expected error in mat hashtable-arguments: "hashtable-values: (hash . table) is not a hashtable".
+  hash.mo:Expected error in mat hashtable-arguments: "hashtable-values: -79 is not a valid length".
+  hash.mo:Expected error in mat hashtable-arguments: "hashtable-values: not-an-unsigned-integer is not a valid length".
 ! hash.mo:Expected error in mat hashtable-arguments: "incorrect number of arguments to #<procedure hashtable-entries>".
 ! hash.mo:Expected error in mat hashtable-arguments: "incorrect number of arguments to #<procedure hashtable-entries>".
   hash.mo:Expected error in mat hashtable-arguments: "hashtable-entries: (hash . table) is not a hashtable".
+  hash.mo:Expected error in mat hashtable-arguments: "hashtable-entries: -79 is not a valid length".
+  hash.mo:Expected error in mat hashtable-arguments: "hashtable-entries: not-an-unsigned-integer is not a valid length".
+! hash.mo:Expected error in mat hashtable-arguments: "incorrect number of arguments to #<procedure hashtable-entries>".
+! hash.mo:Expected error in mat hashtable-arguments: "incorrect number of arguments to #<procedure hashtable-entries>".
+  hash.mo:Expected error in mat hashtable-arguments: "hashtable-entries: (hash . table) is not a hashtable".
+! hash.mo:Expected error in mat hashtable-arguments: "incorrect number of arguments to #<procedure hashtable-cells>".
+! hash.mo:Expected error in mat hashtable-arguments: "incorrect number of arguments to #<procedure hashtable-cells>".
+  hash.mo:Expected error in mat hashtable-arguments: "hashtable-cells: (hash . table) is not a hashtable".
+  hash.mo:Expected error in mat hashtable-arguments: "hashtable-cells: -79 is not a valid length".
+  hash.mo:Expected error in mat hashtable-arguments: "hashtable-cells: not-an-unsigned-integer is not a valid length".
 ! hash.mo:Expected error in mat hashtable-arguments: "incorrect number of arguments to #<procedure hashtable-hash-function>".
 ! hash.mo:Expected error in mat hashtable-arguments: "incorrect number of arguments to #<procedure hashtable-hash-function>".
   hash.mo:Expected error in mat hashtable-arguments: "hashtable-hash-function: (hash . table) is not an eq hashtable".

mats/patch-interpret-3-f-f-f

@@ -1,5 +1,5 @@
-*** errors-compile-3-f-f-f	2018-05-21 15:41:36.322395203 -0400
+*** errors-compile-3-f-f-f	2018-08-26 16:35:50.000000000 -0600
---- errors-interpret-3-f-f-f	2018-05-21 16:32:29.625426575 -0400
+--- errors-interpret-3-f-f-f	2018-08-26 17:36:30.000000000 -0600
 ***************
 *** 1,3 ****
 --- 1,9 ----

mats/patch-interpret-3-f-t-f

@@ -1,5 +1,5 @@
-*** errors-compile-3-f-t-f	2018-05-21 15:49:28.816472990 -0400
+*** errors-compile-3-f-t-f	2018-08-26 16:45:06.000000000 -0600
---- errors-interpret-3-f-t-f	2018-05-21 16:15:47.611381258 -0400
+--- errors-interpret-3-f-t-f	2018-08-26 17:13:32.000000000 -0600
 ***************
 *** 1,3 ****
 --- 1,9 ----

mats/root-experr-compile-0-f-f-f

@@ -7555,14 +7555,31 @@ hash.mo:Expected error in mat hashtable-arguments: "hashtable-clear!: #<eq hasht
 hash.mo:Expected error in mat hashtable-arguments: "hashtable-clear!: #<eq hashtable> is not mutable".
 hash.mo:Expected error in mat hashtable-arguments: "hashtable-clear!: invalid size argument #t".
 hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-keys)".
+hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-keys $ht 72 43)".
+hash.mo:Expected error in mat hashtable-arguments: "hashtable-keys: (hash . table) is not a hashtable".
+hash.mo:Expected error in mat hashtable-arguments: "hashtable-keys: -79 is not a valid length".
+hash.mo:Expected error in mat hashtable-arguments: "hashtable-keys: not-an-unsigned-integer is not a valid length".
+hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-keys)".
 hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-keys $ht 72)".
 hash.mo:Expected error in mat hashtable-arguments: "hashtable-keys: (hash . table) is not a hashtable".
 hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-values)".
-hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-values $ht 72)".
+hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-values $ht 72 43)".
 hash.mo:Expected error in mat hashtable-arguments: "hashtable-values: (hash . table) is not a hashtable".
+hash.mo:Expected error in mat hashtable-arguments: "hashtable-values: -79 is not a valid length".
+hash.mo:Expected error in mat hashtable-arguments: "hashtable-values: not-an-unsigned-integer is not a valid length".
+hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-entries)".
+hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-entries $ht 72 43)".
+hash.mo:Expected error in mat hashtable-arguments: "hashtable-entries: (hash . table) is not a hashtable".
+hash.mo:Expected error in mat hashtable-arguments: "hashtable-entries: -79 is not a valid length".
+hash.mo:Expected error in mat hashtable-arguments: "hashtable-entries: not-an-unsigned-integer is not a valid length".
 hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-entries)".
 hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-entries $ht 72)".
 hash.mo:Expected error in mat hashtable-arguments: "hashtable-entries: (hash . table) is not a hashtable".
+hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-cells)".
+hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-cells $ht 72 43)".
+hash.mo:Expected error in mat hashtable-arguments: "hashtable-cells: (hash . table) is not a hashtable".
+hash.mo:Expected error in mat hashtable-arguments: "hashtable-cells: -79 is not a valid length".
+hash.mo:Expected error in mat hashtable-arguments: "hashtable-cells: not-an-unsigned-integer is not a valid length".
 hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-hash-function)".
 hash.mo:Expected error in mat hashtable-arguments: "incorrect argument count in call (hashtable-hash-function $ht $ht)".
 hash.mo:Expected error in mat hashtable-arguments: "hashtable-hash-function: (hash . table) is not an eq hashtable".

release_notes/release_notes.stex

@@ -58,6 +58,14 @@ Online versions of both books can be found at
 %-----------------------------------------------------------------------------
 \section{Functionality Changes}\label{section:functionality}
 
+\subsection{Extracting a subset of hashtable entries (9.5.1)}
+
+The new \scheme{hashtable-cells} function is similar to
+\scheme{hashtable-entries}, but it returns a vector of cells instead
+of two vectors. An optional argument to \scheme{hashtable-keys},
+\scheme{hashtable-values}, \scheme{hashtable-entries}, or \scheme{hashtable-cells}
+limits the size of the result vector.
+
 \subsection{Profile data retained for reclaimed code (9.5.1)}
 
 Profile data is now retained indefinitely even for code objects

s/newhash.ss

@@ -50,6 +50,7 @@ Documentation notes:
 (define hashtable-clear!)                ; hashtable [k], k >= 0
 (define hashtable-keys)                  ; hashtable
 (define hashtable-entries)               ; hashtable
+(define hashtable-cells)                 ; hashtable
 (define hashtable-equivalence-function)  ; hashtable
 (define hashtable-hash-function)         ; hashtable
 (define hashtable-mutable?)              ; hashtable
@@ -91,6 +92,7 @@ Documentation notes:
 (define $eq-hashtable-keys)              ; eq-hashtable
 (define $eq-hashtable-values)            ; eq-hashtable
 (define $eq-hashtable-entries)           ; eq-hashtable
+(define $eq-hashtable-cells)             ; eq-hashtable
 (define $eq-hashtable-copy)              ; eq-hashtable [mutableflag]
 (define $eq-hashtable-clear!)            ; eq-hashtable [fxminlen]
 
@@ -258,51 +260,70 @@ Documentation notes:
       (ht-size-set! h 0)))
 
   (define $ht-hashtable-keys
-    (lambda (h)
+    (lambda (h max-sz)
-      (let ([keys (make-vector (ht-size h))]
+      (let ([size (fxmin max-sz (ht-size h))])
-            [vec (ht-vec h)])
+        (let ([keys (make-vector size)]
-        (let ([n (vector-length vec)])
+              [vec (ht-vec h)])
-          (let f ([i 0] [ikey 0])
+          (let ([n (vector-length vec)])
-            (unless (fx= i n)
+            (let f ([i 0] [ikey 0])
-              (let g ([b (vector-ref vec i)] [ikey ikey])
+              (unless (or (fx= i n) (fx= ikey size))
-                (if (null? b)
+                (let g ([b (vector-ref vec i)] [ikey ikey])
-                    (f (fx+ i 1) ikey)
+                  (if (or (null? b) (fx= ikey size))
-                    (begin
+                      (f (fx+ i 1) ikey)
-                      (vector-set! keys ikey (caar b))
+                      (begin
-                      (g (cdr b) (fx+ ikey 1))))))))
+                        (vector-set! keys ikey (caar b))
-        keys)))
+                        (g (cdr b) (fx+ ikey 1))))))))
+          keys))))
 
   (define $ht-hashtable-values
-    (lambda (h)
+    (lambda (h max-sz)
-      (let ([vals (make-vector (ht-size h))]
+      (let ([size (fxmin max-sz (ht-size h))])
-            [vec (ht-vec h)])
+        (let ([vals (make-vector size)]
-        (let ([n (vector-length vec)])
+              [vec (ht-vec h)])
-          (let f ([i 0] [ival 0])
+          (let ([n (vector-length vec)])
-            (unless (fx= i n)
+            (let f ([i 0] [ival 0])
-              (let g ([b (vector-ref vec i)] [ival ival])
+              (unless (or (fx= i n) (fx= ival size))
-                (if (null? b)
+                (let g ([b (vector-ref vec i)] [ival ival])
-                    (f (fx+ i 1) ival)
+                  (if (or (null? b) (fx= ival size))
-                    (begin
+                      (f (fx+ i 1) ival)
-                      (vector-set! vals ival (cdar b))
+                      (begin
-                      (g (cdr b) (fx+ ival 1))))))))
+                        (vector-set! vals ival (cdar b))
-        vals)))
+                        (g (cdr b) (fx+ ival 1))))))))
+          vals))))
 
   (define $ht-hashtable-entries
-    (lambda (h)
+    (lambda (h max-sz)
-      (let ([keys (make-vector (ht-size h))]
+      (let ([size (fxmin max-sz (ht-size h))])
-            [vals (make-vector (ht-size h))]
+        (let ([keys (make-vector size)]
-            [vec (ht-vec h)])
+              [vals (make-vector size)]
-        (let ([n (vector-length vec)])
+              [vec (ht-vec h)])
-          (let f ([i 0] [ikey 0])
+          (let ([n (vector-length vec)])
-            (unless (fx= i n)
+            (let f ([i 0] [ikey 0])
-              (let g ([b (vector-ref vec i)] [ikey ikey])
+              (unless (or (fx= i n) (fx= ikey size))
-                (if (null? b)
+                (let g ([b (vector-ref vec i)] [ikey ikey])
-                    (f (fx+ i 1) ikey)
+                  (if (or (null? b) (fx= ikey size))
-                    (let ([a (car b)])
+                      (f (fx+ i 1) ikey)
-                      (vector-set! keys ikey (car a))
+                      (let ([a (car b)])
-                      (vector-set! vals ikey (cdr a))
+                        (vector-set! keys ikey (car a))
-                      (g (cdr b) (fx+ ikey 1))))))))
+                        (vector-set! vals ikey (cdr a))
-        (values keys vals))))
+                        (g (cdr b) (fx+ ikey 1))))))))
+          (values keys vals)))))
+
+  (define $ht-hashtable-cells
+    (lambda (h max-sz)
+      (let ([size (fxmin max-sz (ht-size h))])
+        (let ([cells (make-vector size)]
+              [vec (ht-vec h)])
+          (let ([n (vector-length vec)])
+            (let f ([i 0] [icell 0])
+              (unless (or (fx= i n) (fx= icell size))
+                (let g ([b (vector-ref vec i)] [icell icell])
+                  (if (or (null? b) (fx= icell size))
+                      (f (fx+ i 1) icell)
+                      (let ([a (car b)])
+                        (vector-set! cells icell a)
+                        (g (cdr b) (fx+ icell 1))))))))
+          cells))))
 
   (define eqv-generic?
     (lambda (x)
@@ -351,7 +372,7 @@ Documentation notes:
         ($eq-hashtable-copy (eqv-ht-eqht h) mutable?)
         ($gen-hashtable-copy (eqv-ht-genht h) mutable?))))
 
-  (module ($eqv-hashtable-keys $eqv-hashtable-values $eqv-hashtable-entries)
+  (module ($eqv-hashtable-keys $eqv-hashtable-values $eqv-hashtable-entries $eqv-hashtable-cells)
     (define vector-append
       (lambda (v1 v2)
         (let ([n1 (vector-length v1)] [n2 (vector-length v2)])
@@ -368,22 +389,27 @@ Documentation notes:
                       (vector-set! v j (vector-ref v2 i)))
                     v))))))
     (define $eqv-hashtable-keys
-      (lambda (h)
+      (lambda (h max-sz)
-        (vector-append 
+        (let* ([keys1 ($eq-hashtable-keys (eqv-ht-eqht h) max-sz)]
-          ($eq-hashtable-keys (eqv-ht-eqht h))
+               [keys2 ($ht-hashtable-keys (eqv-ht-genht h) (fx- max-sz (vector-length keys1)))])
-          ($ht-hashtable-keys (eqv-ht-genht h)))))
+          (vector-append keys1 keys2))))
     (define $eqv-hashtable-values
-      (lambda (h)
+      (lambda (h max-sz)
-        (vector-append 
+        (let* ([vals1 ($eq-hashtable-values (eqv-ht-eqht h) max-sz)]
-          ($eq-hashtable-values (eqv-ht-eqht h))
+               [vals2 ($ht-hashtable-values (eqv-ht-genht h) (fx- max-sz (vector-length vals1)))])
-          ($ht-hashtable-values (eqv-ht-genht h)))))
+          (vector-append vals1 vals2))))
     (define $eqv-hashtable-entries
-      (lambda (h)
+      (lambda (h max-sz)
-        (let-values ([(keys1 vals1) ($eq-hashtable-entries (eqv-ht-eqht h))]
+        (let*-values ([(keys1 vals1) ($eq-hashtable-entries (eqv-ht-eqht h) max-sz)]
-                     [(keys2 vals2) ($ht-hashtable-entries (eqv-ht-genht h))])
+                      [(keys2 vals2) ($ht-hashtable-entries (eqv-ht-genht h) (fx- max-sz (vector-length keys1)))])
           (values
             (vector-append keys1 keys2)
-            (vector-append vals1 vals2))))))
+            (vector-append vals1 vals2)))))
+    (define $eqv-hashtable-cells
+      (lambda (h max-sz)
+        (let* ([cells1 ($eq-hashtable-cells (eqv-ht-eqht h) max-sz)]
+               [cells2 ($ht-hashtable-cells (eqv-ht-genht h) (fx- max-sz (vector-length cells1)))])
+          (vector-append cells1 cells2)))))
 
   (define number-hash
     (lambda (z)
@@ -477,7 +503,7 @@ Documentation notes:
     (lambda (h p)
       (unless (eq-ht? h) ($oops who "~s is not an eq hashtable" h))
       (unless (procedure? p) ($oops who "~s is not a procedure" p))
-      (let-values ([(keys vals) ($eq-hashtable-entries h)])
+      (let-values ([(keys vals) ($eq-hashtable-entries h (most-positive-fixnum))])
         (let f ([i (vector-length keys)] [ls '()])
           (if (fx= i 0)
               ls
@@ -488,7 +514,7 @@ Documentation notes:
     (lambda (h p)
       (unless (eq-ht? h) ($oops who "~s is not an eq hashtable" h))
       (unless (procedure? p) ($oops who "~s is not a procedure" p))
-      (let-values ([(keys vals) ($eq-hashtable-entries h)])
+      (let-values ([(keys vals) ($eq-hashtable-entries h (most-positive-fixnum))])
         (vector-for-each p keys vals))))
 
   (set-who! make-eq-hashtable
@@ -775,31 +801,73 @@ Documentation notes:
               ($ht-hashtable-clear! (eqv-ht-genht h) minlen)]
              [else ($ht-hashtable-clear! h minlen)]))])))
 
-  (set! hashtable-keys
+  (let ()
-    (lambda (h)
+    (define (invalid-length who max-sz)
-      (unless (xht? h)
+      ($oops who "~s is not a valid length" max-sz))
-        ($oops 'hashtable-keys "~s is not a hashtable" h))
+    (define (invalid-table who h)
-      (case (xht-type h)
+      ($oops who "~s is not a hashtable" h))
-        [(eq) ($eq-hashtable-keys h)]
-        [(eqv) ($eqv-hashtable-keys h)]
-        [else ($ht-hashtable-keys h)])))
 
-  (set-who! hashtable-values
+    (define-syntax hashtable-content-dispatch
-    (lambda (h)
+      (syntax-rules ()
-      (unless (xht? h) ($oops who "~s is not a hashtable" h))
+        [(_ who $eq-hashtable-content $eqv-hashtable-content $ht-hashtable-content)
-      (case (xht-type h)
+         (let ()
-        [(eq) ($eq-hashtable-values h)]
+           (define (dispatch h max-sz)
-        [(eqv) ($eqv-hashtable-values h)]
+             (unless (xht? h) (invalid-table who h))
-        [else ($ht-hashtable-values h)])))
+             (case (xht-type h)
+               [(eq) ($eq-hashtable-content h max-sz)]
+               [(eqv) ($eqv-hashtable-content h max-sz)]
+               [else ($ht-hashtable-content h max-sz)]))
+           (case-lambda
+            [(h max-sz)
+             (cond
+              [(fixnum? max-sz)
+               (unless (fx>= max-sz 0) (invalid-length who max-sz))
+               (dispatch h max-sz)]
+              [(bignum? max-sz)
+               (unless (>= max-sz 0) (invalid-length who max-sz))
+               (dispatch h (most-positive-fixnum))]
+              [else (invalid-length who max-sz)])]
+            [(h) (dispatch h (most-positive-fixnum))]))]))
 
-  (set! hashtable-entries
+    (set-who! hashtable-keys
-    (lambda (h)
+      (hashtable-content-dispatch who
-      (unless (xht? h)
+                                  $eq-hashtable-keys
-        ($oops 'hashtable-entries "~s is not a hashtable" h))
+                                  $eqv-hashtable-keys
-      (case (xht-type h)
+                                  $ht-hashtable-keys))
-        [(eq) ($eq-hashtable-entries h)]
+
-        [(eqv) ($eqv-hashtable-entries h)]
+    (set-who! #(r6rs: hashtable-keys)
-        [else ($ht-hashtable-entries h)])))
+      (lambda (h)
+        (unless (xht? h) (invalid-table who h))
+        (case (xht-type h)
+          [(eq) ($eq-hashtable-keys h (most-positive-fixnum))]
+          [(eqv) ($eqv-hashtable-keys h (most-positive-fixnum))]
+          [else ($ht-hashtable-keys h (most-positive-fixnum))])))
+
+    (set-who! hashtable-values
+      (hashtable-content-dispatch who
+                                  $eq-hashtable-values
+                                  $eqv-hashtable-values
+                                  $ht-hashtable-values))
+
+    (set-who! hashtable-entries
+      (hashtable-content-dispatch who
+                                  $eq-hashtable-entries
+                                  $eqv-hashtable-entries
+                                  $ht-hashtable-entries))
+
+    (set-who! #(r6rs: hashtable-entries)
+      (lambda (h)
+        (unless (xht? h) (invalid-table who h))
+        (case (xht-type h)
+          [(eq) ($eq-hashtable-entries h (most-positive-fixnum))]
+          [(eqv) ($eqv-hashtable-entries h (most-positive-fixnum))]
+          [else ($ht-hashtable-entries h (most-positive-fixnum))])))
+
+    (set-who! hashtable-cells
+      (hashtable-content-dispatch who
+                                  $eq-hashtable-cells
+                                  $eqv-hashtable-cells
+                                  $ht-hashtable-cells)))
 
   (set! hashtable-size
     (lambda (h)
@@ -985,50 +1053,64 @@ Documentation notes:
   (include "hashtable-types.ss")
 
   (set! $eq-hashtable-keys
-    (lambda (h)
+    (lambda (h max-sz)
-      (let ([vec (ht-vec h)] [size (ht-size h)])
+      (let ([vec (ht-vec h)] [size (fxmin max-sz (ht-size h))])
         (let ([n (vector-length vec)] [keys (make-vector size)])
           (let outer ([i 0] [j 0])
-            (if (fx= i n)
+            (if (or (fx= i n) (fx= j size))
                 keys
                 (let inner ([b (vector-ref vec i)] [j j])
-                  (if (fixnum? b)
+                  (if (or (fixnum? b) (fx= j size))
                       (outer (fx+ i 1) j)
                       (let ([keyval ($tlc-keyval b)])
                         (vector-set! keys j (car keyval))
                         (inner ($tlc-next b) (fx+ j 1)))))))))))
 
   (set! $eq-hashtable-values
-    (lambda (h)
+    (lambda (h max-sz)
-      (let ([vec (ht-vec h)] [size (ht-size h)])
+      (let ([vec (ht-vec h)] [size (fxmin max-sz (ht-size h))])
         (let ([n (vector-length vec)] [vals (make-vector size)])
           (let outer ([i 0] [j 0])
-            (if (fx= i n)
+            (if (or (fx= i n) (fx= j size))
                 vals
                 (let inner ([b (vector-ref vec i)] [j j])
-                  (if (fixnum? b)
+                  (if (or (fixnum? b) (fx= j size))
                       (outer (fx+ i 1) j)
                       (let ([keyval ($tlc-keyval b)])
                         (vector-set! vals j (cdr keyval))
                         (inner ($tlc-next b) (fx+ j 1)))))))))))
 
   (set! $eq-hashtable-entries
-    (lambda (h)
+    (lambda (h max-sz)
-      (let ([vec (ht-vec h)] [size (ht-size h)])
+      (let ([vec (ht-vec h)] [size (fxmin max-sz (ht-size h))])
         (let ([n (vector-length vec)]
               [keys (make-vector size)]
               [vals (make-vector size)])
           (let outer ([i 0] [j 0])
-            (if (fx= i n)
+            (if (or (fx= i n) (fx= j size))
                 (values keys vals)
                 (let inner ([b (vector-ref vec i)] [j j])
-                  (if (fixnum? b)
+                  (if (or (fixnum? b) (fx= j size))
                       (outer (fx+ i 1) j)
                       (let ([keyval ($tlc-keyval b)])
                         (vector-set! keys j (car keyval))
                         (vector-set! vals j (cdr keyval))
                         (inner ($tlc-next b) (fx+ j 1)))))))))))
 
+  (set! $eq-hashtable-cells
+    (lambda (h max-sz)
+      (let ([vec (ht-vec h)] [size (fxmin max-sz (ht-size h))])
+        (let ([n (vector-length vec)] [cells (make-vector size)])
+          (let outer ([i 0] [j 0])
+            (if (or (fx= i n) (fx= j size))
+                cells
+                (let inner ([b (vector-ref vec i)] [j j])
+                  (if (or (fixnum? b) (fx= j size))
+                      (outer (fx+ i 1) j)
+                      (let ([keyval ($tlc-keyval b)])
+                        (vector-set! cells j keyval)
+                        (inner ($tlc-next b) (fx+ j 1)))))))))))
+
   (set! $eq-hashtable-copy
     (lambda (h1 mutable?)
       (let ([subtype (eq-ht-subtype h1)])

s/primdata.ss

@@ -529,8 +529,8 @@
   (hashtable-update! [sig [(hashtable ptr procedure ptr) -> (void)]] [flags])
   (hashtable-copy [sig [(hashtable) (hashtable ptr) -> (hashtable)]] [flags alloc])
   (hashtable-clear! [sig [(hashtable) (hashtable sub-uint) -> (void)]] [flags true])
-  (hashtable-keys [sig [(hashtable) -> (vector)]] [flags alloc])
+  ((r6rs: hashtable-keys) [sig [(hashtable) -> (vector)]] [flags alloc])           ; no size argument
-  (hashtable-entries [sig [(hashtable) -> (vector vector)]] [flags alloc])
+  ((r6rs: hashtable-entries) [sig [(hashtable) -> (vector vector)]] [flags alloc]) ; no size argument
   (hashtable-equivalence-function [sig [(hashtable) -> (ptr)]] [flags])
   (hashtable-hash-function [sig [(hashtable) -> (ptr)]] [flags])
   (hashtable-mutable? [sig [(hashtable) -> (boolean)]] [flags mifoldable discard])
@@ -1373,7 +1373,10 @@
   (hash-table-for-each [sig [(old-hash-table procedure) -> (void)]] [flags])
   (hash-table-map [sig [(old-hash-table procedure) -> (list)]] [flags true])
   (hashtable-cell [sig [(old-hash-table ptr ptr) -> ((ptr . ptr))]] [flags true])
-  (hashtable-values [sig [(hashtable) -> (vector)]] [flags alloc])
+  (hashtable-cells [sig [(hashtable) -> (vector)] [(hashtable uint) -> (vector)]] [flags alloc])
+  (hashtable-entries [sig [(hashtable) -> (vector vector)] [(hashtable uint) -> (vector vector)]] [flags alloc]) ; has size argument
+  (hashtable-keys [sig [(hashtable) -> (vector)] [(hashtable uint) -> (vector)]] [flags alloc])                  ; has size argument
+  (hashtable-values [sig [(hashtable) -> (vector)] [(hashtable uint) -> (vector)]] [flags alloc])
   (hashtable-weak? [sig [(hashtable) -> (boolean)]] [flags pure mifoldable discard])
   (iconv-codec [feature iconv] [sig [(sub-string) -> (codec)]] [flags pure true])
   (ieee-environment [sig [() -> (environment)]] [flags unrestricted alloc])
@@ -1785,6 +1788,7 @@
   ($dynamic-closure-counts [flags alloc])  ; added for closure instrumentation
   ($enum-set-members [flags])
   ($eol-style? [flags])
+  ($eq-hashtable-cells [flags discard])
   ($eq-hashtable-clear! [flags true])
   ($eq-hashtable-copy [flags true discard])
   ($eq-hashtable-entries [flags discard])