suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

committing @mflatt hashtable-cells pull request

Browse Source 
original commit: 1900a7ef534366a4311a714cf56b9c60657ba0a1
This commit is contained in:
Matthew Flatt 2019-02-07 11:08:03 -08:00 committed by dyb
parent a1195b7f7e
commit 13b6b6943b
10 changed files with 574 additions and 465 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
LOG
View File

@ -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

92
csug/objects.stex
View File

@ -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)
(let-values ([(keys values) (hashtable-entries ht)])
values))
(define ht (make-eq-hashtable))
(hashtable-set! ht 'a "one")
(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

593
mats/hash.ms
View File

File diff suppressed because it is too large Load Diff

36
mats/patch-compile-0-t-f-f
View File

@ -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".

4
mats/patch-interpret-3-f-f-f
View File

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

4
mats/patch-interpret-3-f-t-f
View File

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

19
mats/root-experr-compile-0-f-f-f
View File

@ -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".

8
release_notes/release_notes.stex
View File

@ -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

206
s/newhash.ss
View File

@ -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)
(let ([keys (make-vector (ht-size h))]
(lambda (h max-sz)
(let ([size (fxmin max-sz (ht-size h))])
(let ([keys (make-vector size)]
[vec (ht-vec h)])
(let ([n (vector-length vec)])
(let f ([i 0] [ikey 0])
(unless (fx= i n)
(unless (or (fx= i n) (fx= ikey size))
(let g ([b (vector-ref vec i)] [ikey ikey])
(if (null? b)
(if (or (null? b) (fx= ikey size))
(f (fx+ i 1) ikey)
(begin
(vector-set! keys ikey (caar b))
(g (cdr b) (fx+ ikey 1))))))))
keys)))
keys))))
(define $ht-hashtable-values
(lambda (h)
(let ([vals (make-vector (ht-size h))]
(lambda (h max-sz)
(let ([size (fxmin max-sz (ht-size h))])
(let ([vals (make-vector size)]
[vec (ht-vec h)])
(let ([n (vector-length vec)])
(let f ([i 0] [ival 0])
(unless (fx= i n)
(unless (or (fx= i n) (fx= ival size))
(let g ([b (vector-ref vec i)] [ival ival])
(if (null? b)
(if (or (null? b) (fx= ival size))
(f (fx+ i 1) ival)
(begin
(vector-set! vals ival (cdar b))
(g (cdr b) (fx+ ival 1))))))))
vals)))
vals))))
(define $ht-hashtable-entries
(lambda (h)
(let ([keys (make-vector (ht-size h))]
[vals (make-vector (ht-size h))]
(lambda (h max-sz)
(let ([size (fxmin max-sz (ht-size h))])
(let ([keys (make-vector size)]
[vals (make-vector size)]
[vec (ht-vec h)])
(let ([n (vector-length vec)])
(let f ([i 0] [ikey 0])
(unless (fx= i n)
(unless (or (fx= i n) (fx= ikey size))
(let g ([b (vector-ref vec i)] [ikey ikey])
(if (null? b)
(if (or (null? b) (fx= ikey size))
(f (fx+ i 1) ikey)
(let ([a (car b)])
(vector-set! keys ikey (car a))
(vector-set! vals ikey (cdr a))
(g (cdr b) (fx+ ikey 1))))))))
(values keys vals))))
(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)
(vector-append
($eq-hashtable-keys (eqv-ht-eqht h))
($ht-hashtable-keys (eqv-ht-genht h)))))
(lambda (h max-sz)
(let* ([keys1 ($eq-hashtable-keys (eqv-ht-eqht h) max-sz)]
[keys2 ($ht-hashtable-keys (eqv-ht-genht h) (fx- max-sz (vector-length keys1)))])
(vector-append keys1 keys2))))
(define $eqv-hashtable-values
(lambda (h)
(vector-append
($eq-hashtable-values (eqv-ht-eqht h))
($ht-hashtable-values (eqv-ht-genht h)))))
(lambda (h max-sz)
(let* ([vals1 ($eq-hashtable-values (eqv-ht-eqht h) max-sz)]
[vals2 ($ht-hashtable-values (eqv-ht-genht h) (fx- max-sz (vector-length vals1)))])
(vector-append vals1 vals2))))
(define $eqv-hashtable-entries
(lambda (h)
(let-values ([(keys1 vals1) ($eq-hashtable-entries (eqv-ht-eqht h))]
[(keys2 vals2) ($ht-hashtable-entries (eqv-ht-genht h))])
(lambda (h max-sz)
(let*-values ([(keys1 vals1) ($eq-hashtable-entries (eqv-ht-eqht h) max-sz)]
[(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
(lambda (h)
(unless (xht? h)
($oops 'hashtable-keys "~s is not a hashtable" h))
(let ()
(define (invalid-length who max-sz)
($oops who "~s is not a valid length" max-sz))
(define (invalid-table who h)
($oops who "~s is not a hashtable" h))
(define-syntax hashtable-content-dispatch
(syntax-rules ()
[(_ who $eq-hashtable-content $eqv-hashtable-content $ht-hashtable-content)
(let ()
(define (dispatch h max-sz)
(unless (xht? h) (invalid-table who h))
(case (xht-type h)
[(eq) ($eq-hashtable-keys h)]
[(eqv) ($eqv-hashtable-keys h)]
[else ($ht-hashtable-keys 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-who! hashtable-keys
(hashtable-content-dispatch who
$eq-hashtable-keys
$eqv-hashtable-keys
$ht-hashtable-keys))
(set-who! #(r6rs: hashtable-keys)
(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
(lambda (h)
(unless (xht? h) ($oops who "~s is not a hashtable" h))
(case (xht-type h)
[(eq) ($eq-hashtable-values h)]
[(eqv) ($eqv-hashtable-values h)]
[else ($ht-hashtable-values h)])))
(hashtable-content-dispatch who
$eq-hashtable-values
$eqv-hashtable-values
$ht-hashtable-values))
(set! hashtable-entries
(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)
($oops 'hashtable-entries "~s is not a hashtable" h))
(unless (xht? h) (invalid-table who h))
(case (xht-type h)
[(eq) ($eq-hashtable-entries h)]
[(eqv) ($eqv-hashtable-entries h)]
[else ($ht-hashtable-entries 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)
(let ([vec (ht-vec h)] [size (ht-size h)])
(lambda (h max-sz)
(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)
(let ([vec (ht-vec h)] [size (ht-size h)])
(lambda (h max-sz)
(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)
(let ([vec (ht-vec h)] [size (ht-size h)])
(lambda (h max-sz)
(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)])

10
s/primdata.ss
View File

@ -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])
(hashtable-entries [sig [(hashtable) -> (vector vector)]] [flags alloc])
((r6rs: hashtable-keys) [sig [(hashtable) -> (vector)]] [flags alloc]) ; no size argument
((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])