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

Merge addition of hashtable-cells

Browse Source 
original commit: 180948f4a6b18ffcc45fe1231b04b69c4b0bc3ff
This commit is contained in:
Matthew Flatt 2018-07-30 15:39:49 -06:00
commit 08a9c8ecf6
6 changed files with 187 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
LOG
View File

@ -1013,3 +1013,7 @@
cmacro.ss, primdata.ss, library.ss types.ss, mkheader.ss,
alloc.c, gc.c, schsig.c, thread.c, externs.h,
4.ms, control.stex, release_notes.stex
- add hashtable-cells
newhash.ss, primdata.ss,
hash.ms, root-experr*,
objects.stex, release_notes.stex

29
csug/objects.stex
View File

@ -1862,7 +1862,7 @@ 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}
\endschemedisplay
This procedure is equivalent to:
@ -1876,6 +1876,33 @@ This procedure is equivalent to:
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
\formdef{make-weak-eq-hashtable}{\categoryprocedure}{(make-weak-eq-hashtable)}

88
mats/hash.ms
View File

@ -504,6 +504,17 @@
(hashtable-entries $ht 72))
(error? ; not a hashtable
(hashtable-entries '(hash . table)))
; hashtable-cells
(error? ; wrong argument count
(hashtable-cells))
(error? ; wrong argument count
(hashtable-cells $ht 72 43))
(error? ; not a hashtable
(hashtable-cells '(hash . table)))
(error? ; bad size
(hashtable-cells $ht -79))
(error? ; bad size
(hashtable-cells $ht 'not-an-unsigned-integer))
; hashtable-hash-function
(error? ; wrong argument count
(hashtable-hash-function))
@ -919,6 +930,9 @@
(same-elements? (hashtable-keys h) '#())
(same-elements? (hashtable-values h) '#())
(equal-entries? (hashtable-entries h) '#() '#())
(same-elements? (hashtable-cells h) '#())
(same-elements? (hashtable-cells h 0) '#())
(same-elements? (hashtable-cells h 10) '#())
(eqv? (hashtable-set! h 'a 'aval) (void))
(equal?
(list
@ -944,6 +958,12 @@
(same-elements? (hashtable-keys h) '#(a b c))
(same-elements? (hashtable-values h) '#(bval cval aval))
(equal-entries? (hashtable-entries h) '#(b c a) '#(bval cval aval))
(same-elements? (hashtable-cells h) '#((b . bval) (c . cval) (a . aval)))
(same-elements? (hashtable-cells h (expt 2 100)) '#((b . bval) (c . cval) (a . aval)))
(let ([cells (hashtable-cells h 2)])
(or (same-elements? cells '#((b . bval) (c . cval)))
(same-elements? cells '#((b . bval) (a . aval)))
(same-elements? cells '#((c . cval) (a . aval)))))
#;(same-elements? (list->vector (hashtable-map h cons)) '#((a . aval) (b . bval) (c . cval)))
#;(same-elements?
(let ([v (make-vector 3)] [i 0])
@ -1063,6 +1083,9 @@
(same-elements? (hashtable-keys h) '#())
(same-elements? (hashtable-values h) '#())
(equal-entries? (hashtable-entries h) '#() '#())
(same-elements? (hashtable-cells h) '#())
(same-elements? (hashtable-cells h 0) '#())
(same-elements? (hashtable-cells h 10) '#())
(eqv? (hashtable-set! h ka 'aval) (void))
(equal?
(list
@ -1088,6 +1111,13 @@
(same-elements? (hashtable-keys h) '#((a) (b) (c)))
(same-elements? (hashtable-values h) '#(bval cval aval))
(equal-entries? (hashtable-entries h) '#((a) (b) (c)) '#(aval bval cval))
(same-elements? (hashtable-cells h) (vector (cons ka 'aval) (cons kb 'bval) (cons kc 'cval)))
(same-elements? (hashtable-cells h (expt 2 100)) (vector (cons ka 'aval) (cons kb 'bval) (cons kc 'cval)))
(let ([cells (hashtable-cells h 2)])
(or (same-elements? cells (vector (cons ka 'aval) (cons kb 'bval)))
(same-elements? cells (vector (cons ka 'aval) (cons kc 'cval)))
(same-elements? cells (vector (cons kb 'bval) (cons kc 'cval)))))
(andmap weak-pair? (vector->list (hashtable-cells h)))
#;(same-elements? (list->vector (hashtable-map h cons)) '#(((a) . aval) ((b) . bval) ((c) . cval)))
#;(same-elements?
(let ([v (make-vector 3)] [i 0])
@ -1165,6 +1195,9 @@
(same-elements? (hashtable-keys h) '#())
(same-elements? (hashtable-values h) '#())
(equal-entries? (hashtable-entries h) '#() '#())
(same-elements? (hashtable-cells h) '#())
(same-elements? (hashtable-cells h 0) '#())
(same-elements? (hashtable-cells h 10) '#())
#;(eqv? (hashtable-map h (lambda args (error #f "oops"))) '())
#;(eqv? (hashtable-for-each h (lambda args (error #f "oops"))) (void))
#;(eqv? (hashtable-for-each-cell h (lambda args (error #f "oops"))) (void))
@ -1299,6 +1332,9 @@
(same-elements? (hashtable-keys h) '#())
(same-elements? (hashtable-values h) '#())
(equal-entries? (hashtable-entries h) '#() '#())
(same-elements? (hashtable-cells h) '#())
(same-elements? (hashtable-cells h 0) '#())
(same-elements? (hashtable-cells h 10) '#())
(eqv? (hashtable-set! h ka ka) (void))
(equal?
(list
@ -1324,6 +1360,13 @@
(same-elements? (hashtable-keys h) '#((a) (b) (c)))
(same-elements? (hashtable-values h) '#((a) (b) (c)))
(equal-entries? (hashtable-entries h) '#((a) (b) (c)) '#((a) (c) (b)))
(same-elements? (hashtable-cells h) (vector (cons ka ka) (cons kb kc) (cons kc kb)))
(same-elements? (hashtable-cells h (expt 2 100)) (vector (cons ka ka) (cons kb kc) (cons kc kb)))
(let ([cells (hashtable-cells h 2)])
(or (same-elements? cells (vector (cons ka ka) (cons kb kc)))
(same-elements? cells (vector (cons ka ka) (cons kc kb)))
(same-elements? cells (vector (cons kb kc) (cons kc kb)))))
(andmap ephemeron-pair? (vector->list (hashtable-cells h)))
#;(same-elements? (list->vector (hashtable-map h cons)) '#(((a) . a) ((b) . c) ((c) . b)))
#;(same-elements?
(let ([v (make-vector 3)] [i 0])
@ -1630,6 +1673,9 @@
(same-elements? (hashtable-keys h) '#())
(same-elements? (hashtable-values h) '#())
(equal-entries? (hashtable-entries h) '#() '#())
(same-elements? (hashtable-cells h) '#())
(same-elements? (hashtable-cells h 0) '#())
(same-elements? (hashtable-cells h 10) '#())
(eqv? (eq-hashtable-set! h 'a 'aval) (void))
(equal?
(list
@ -1655,6 +1701,12 @@
(same-elements? (hashtable-keys h) '#(a b c))
(same-elements? (hashtable-values h) '#(bval cval aval))
(equal-entries? (hashtable-entries h) '#(b c a) '#(bval cval aval))
(same-elements? (hashtable-cells h) '#((a . aval) (b . bval) (c . cval)))
(same-elements? (hashtable-cells h (expt 2 100)) '#((a . aval) (b . bval) (c . cval)))
(let ([cells (hashtable-cells h 2)])
(or (same-elements? cells '#((a . aval) (b . bval)))
(same-elements? cells '#((a . aval) (c . cval)))
(same-elements? cells '#((b . bval) (c . cval)))))
(equal? (eq-hashtable-ref h 'a 1) 'aval)
(equal? (eq-hashtable-ref h 'b #f) 'bval)
(equal? (eq-hashtable-ref h 'c 'nope) 'cval)
@ -1774,6 +1826,9 @@
(same-elements? (hashtable-keys h) '#())
(same-elements? (hashtable-values h) '#())
(equal-entries? (hashtable-entries h) '#() '#())
(same-elements? (hashtable-cells h) '#())
(same-elements? (hashtable-cells h 0) '#())
(same-elements? (hashtable-cells h 10) '#())
(eqv? (eq-hashtable-set! h ka 'aval) (void))
(equal?
(list
@ -1799,6 +1854,13 @@
(same-elements? (hashtable-keys h) '#((a) (b) (c)))
(same-elements? (hashtable-values h) '#(aval bval cval))
(equal-entries? (hashtable-entries h) '#((a) (b) (c)) '#(aval bval cval))
(same-elements? (hashtable-cells h) (vector (cons ka 'aval) (cons kb 'bval) (cons kc 'cval)))
(same-elements? (hashtable-cells h (expt 2 100)) (vector (cons ka 'aval) (cons kb 'bval) (cons kc 'cval)))
(let ([cells (hashtable-cells h 2)])
(or (same-elements? cells (vector (cons ka 'aval) (cons kb 'bval)))
(same-elements? cells (vector (cons ka 'aval) (cons kc 'cval)))
(same-elements? cells (vector (cons kb 'bval) (cons kc 'cval)))))
(andmap weak-pair? (vector->list (hashtable-cells h)))
(equal? (eq-hashtable-ref h ka 1) 'aval)
(equal? (eq-hashtable-ref h kb #f) 'bval)
(equal? (eq-hashtable-ref h kc 'nope) 'cval)
@ -1964,6 +2026,9 @@
(same-elements? (hashtable-keys h) '#())
(same-elements? (hashtable-values h) '#())
(equal-entries? (hashtable-entries h) '#() '#())
(same-elements? (hashtable-cells h) '#())
(same-elements? (hashtable-cells h 0) '#())
(same-elements? (hashtable-cells h 10) '#())
(eqv? (eq-hashtable-set! h ka 'aval) (void))
(equal?
(list
@ -1989,6 +2054,13 @@
(same-elements? (hashtable-keys h) '#((a) (b) (c)))
(same-elements? (hashtable-values h) '#(aval bval cval))
(equal-entries? (hashtable-entries h) '#((a) (b) (c)) '#(aval bval cval))
(same-elements? (hashtable-cells h) (vector (cons ka 'aval) (cons kb 'bval) (cons kc 'cval)))
(same-elements? (hashtable-cells h (expt 2 100)) (vector (cons ka 'aval) (cons kb 'bval) (cons kc 'cval)))
(let ([cells (hashtable-cells h 2)])
(or (same-elements? cells (vector (cons ka 'aval) (cons kb 'bval)))
(same-elements? cells (vector (cons ka 'aval) (cons kc 'cval)))
(same-elements? cells (vector (cons kb 'bval) (cons kc 'cval)))))
(andmap ephemeron-pair? (vector->list (hashtable-cells h)))
(equal? (eq-hashtable-ref h ka 1) 'aval)
(equal? (eq-hashtable-ref h kb #f) 'bval)
(equal? (eq-hashtable-ref h kc 'nope) 'cval)
@ -2308,6 +2380,9 @@
(same-elements? (hashtable-keys h) '#())
(same-elements? (hashtable-values h) '#())
(equal-entries? (hashtable-entries h) '#() '#())
(same-elements? (hashtable-cells h) '#())
(same-elements? (hashtable-cells h 0) '#())
(same-elements? (hashtable-cells h 10) '#())
(eqv? (hashtable-set! h 'a 'aval) (void))
(equal?
(list
@ -2451,6 +2526,9 @@
(same-elements? (hashtable-keys h) '#())
(same-elements? (hashtable-values h) '#())
(equal-entries? (hashtable-entries h) '#() '#())
(same-elements? (hashtable-cells h) '#())
(same-elements? (hashtable-cells h 0) '#())
(same-elements? (hashtable-cells h 10) '#())
(eqv? (hashtable-set! h ka 'aval) (void))
(equal?
(list
@ -2703,6 +2781,9 @@
(same-elements? (hashtable-keys h) '#())
(same-elements? (hashtable-values h) '#())
(equal-entries? (hashtable-entries h) '#() '#())
(same-elements? (hashtable-cells h) '#())
(same-elements? (hashtable-cells h 0) '#())
(same-elements? (hashtable-cells h 10) '#())
(eqv? (hashtable-set! h ka 'aval) (void))
(equal?
(list
@ -3222,6 +3303,9 @@
(same-elements? (hashtable-keys h) '#())
(same-elements? (hashtable-values h) '#())
(equal-entries? (hashtable-entries h) '#() '#())
(same-elements? (hashtable-cells h) '#())
(same-elements? (hashtable-cells h 0) '#())
(same-elements? (hashtable-cells h 10) '#())
(eqv? (hashtable-set! h 'a 'aval) (void))
(equal?
(list
@ -3357,6 +3441,9 @@
(same-elements? (hashtable-keys h) '#())
(same-elements? (hashtable-values h) '#())
(equal-entries? (hashtable-entries h) '#() '#())
(same-elements? (hashtable-cells h) '#())
(same-elements? (hashtable-cells h 0) '#())
(same-elements? (hashtable-cells h 10) '#())
(eqv? (symbol-hashtable-set! h 'a 'aval) (void))
(equal?
(list
@ -3541,6 +3628,7 @@
(same-elements? (hashtable-keys $ght) $ght-keys1)
(same-elements? (hashtable-values $ght) $ght-vals1)
(equal-entries? (hashtable-entries $ght) $ght-keys1 $ght-vals1)
(same-elements? (hashtable-cells $ght) (vector-map cons $ght-keys1 $ght-vals1))
(begin
(define $ght-keys2 '#((a . b) (1 . 2) 3/4 3.4 3.5 1e23 #e1e50 1+1i 3+3.2i -15 #e1e-50 #1=(a . #1#) (#2=(#2# b c))))
(define $ght-vals2 '#(a b c d e f g h i j k l m))

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 cells (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 limits the size of the result vector,
which enables a traversal of $N$ entries in $O(N)$ time when a hash table
has more than $O(N)$ entries.
\subsection{Procedure arity-mask adjustment and redirection (9.5.1)}
The new procedure \scheme{make-arity-wrapper-procedure} creates a

63
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]
@ -304,6 +306,22 @@ Documentation notes:
(g (cdr b) (fx+ ikey 1))))))))
(values keys vals))))
(define $ht-hashtable-cells
(lambda (h max-sz)
(let ([sz (fxmin max-sz (ht-size h))])
(let ([cells (make-vector sz)]
[vec (ht-vec h)])
(let ([n (vector-length vec)])
(let f ([i 0] [icell 0])
(unless (or (fx= i n) (fx= icell sz))
(let g ([b (vector-ref vec i)] [icell icell])
(if (or (null? b) (fx=? icell sz))
(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)
; all numbers except fixnums must go through generic hashtable
@ -351,7 +369,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)])
@ -383,7 +401,12 @@ Documentation notes:
[(keys2 vals2) ($ht-hashtable-entries (eqv-ht-genht h))])
(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)
@ -775,10 +798,10 @@ Documentation notes:
($ht-hashtable-clear! (eqv-ht-genht h) minlen)]
[else ($ht-hashtable-clear! h minlen)]))])))
(set! hashtable-keys
(set-who! hashtable-keys
(lambda (h)
(unless (xht? h)
($oops 'hashtable-keys "~s is not a hashtable" h))
($oops who "~s is not a hashtable" h))
(case (xht-type h)
[(eq) ($eq-hashtable-keys h)]
[(eqv) ($eqv-hashtable-keys h)]
@ -792,15 +815,29 @@ Documentation notes:
[(eqv) ($eqv-hashtable-values h)]
[else ($ht-hashtable-values h)])))
(set! hashtable-entries
(set-who! hashtable-entries
(lambda (h)
(unless (xht? h)
($oops 'hashtable-entries "~s is not a hashtable" h))
($oops who "~s is not a hashtable" h))
(case (xht-type h)
[(eq) ($eq-hashtable-entries h)]
[(eqv) ($eqv-hashtable-entries h)]
[else ($ht-hashtable-entries h)])))
(set-who! hashtable-cells
(case-lambda
[(h max-sz)
(unless (xht? h)
($oops who "~s is not a hashtable" h))
(unless (and (integer? max-sz) (exact? max-sz) (not (negative? max-sz)))
($oops who "~s is not a valid length" max-sz))
(let ([max-sz (if (fixnum? max-sz) max-sz (hashtable-size h))])
(case (xht-type h)
[(eq) ($eq-hashtable-cells h max-sz)]
[(eqv) ($eqv-hashtable-cells h max-sz)]
[else ($ht-hashtable-cells h max-sz)]))]
[(h) (hashtable-cells h (hashtable-size h))]))
(set! hashtable-size
(lambda (h)
(unless (xht? h) ($oops 'hashtable-size "~s is not a hashtable" h))
@ -1029,6 +1066,20 @@ Documentation notes:
(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)])

2
s/primdata.ss
View File

@ -1382,6 +1382,7 @@
(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-cells [sig [(hashtable) -> (vector)] [(hashtable uint) -> (vector)]] [flags alloc])
(hashtable-values [sig [(hashtable) -> (vector)]] [flags alloc])
(hashtable-weak? [sig [(hashtable) -> (boolean)]] [flags pure mifoldable discard])
(iconv-codec [feature iconv] [sig [(sub-string) -> (codec)]] [flags pure true])
@ -1802,6 +1803,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])