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

hash-iterate-value & co.: add an optional bad-index result

Browse Source 
The new argument to `hash-iterate-value` and most other
`...-hash-iterate-...` functions determines a result to be returned in
place of raising a "bad index" exception.

For most kinds of hash tables, a "bad index" exception will only
happen when the provided index is wrong or when a hash table is
mutated during an iteration. Mutation during iteration is generally a
bad idea, but in the case of a weak hash table, a potential background
mutation by the garbage collector is difficult to suppress or ignore.
Adding an option to control bad-index behavior makes it easier to
write loops that defend against uncooperative tables, including loops
where a hash-table key disappears asynchronously.

Racket's printer was already using this functionality internally, so
the change to `hash-iterate-value` and company mostly exposes existing
functionality.

The `in-hash` form and related sequence constructors similarly support
a bad-index alternate value so iterations can handle that case
explicitly. They do not use the new bad-index support implicitly to
skip missing entries, because that idea does not play well with the
iteration API. A hash-table index can go bad after `in-hash` has
selected the index and determined that it should be used for the next
iteration, and a sequence can't take back that decision.
This commit is contained in:
Matthew Flatt 2018-07-30 20:23:49 -06:00
parent 5526113311
commit b7392a688e
13 changed files with 820 additions and 466 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/base/info.rkt
View File

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

115
pkgs/racket-doc/scribblings/reference/hashes.scrbl
View File

@ -464,9 +464,18 @@ Returns @racket[#f] if @racket[hash] contains no elements, otherwise
it returns an integer that is an index to the first element in the hash
table; ``first'' refers to an unspecified ordering of the table
elements, and the index values are not necessarily consecutive
integers. For a mutable @racket[hash], this index is guaranteed to
refer to the first item only as long as no items are added to or
removed from @racket[hash].}
integers.
For a mutable @racket[hash], this index is guaranteed to refer to the
first item only as long as no items are added to or removed from
@racket[hash]. More generally, an index is guaranteed to be a
@deftech{valid hash index} for a given hash table only as long it comes
from @racket[hash-iterate-first] or @racket[hash-iterate-next], and
only as long as the hash table is not modified. In the case of a hash
table with weakly held keys, the hash table can be implicitly modified
by the garbage collector (see @secref["gc-model"]) when it discovers
that the key is not reachable.}
@defproc[(hash-iterate-next [hash hash?]
[pos exact-nonnegative-integer?])
@ -475,49 +484,105 @@ removed from @racket[hash].}
Returns either an integer that is an index to the element in
@racket[hash] after the element indexed by @racket[pos] (which is not
necessarily one more than @racket[pos]) or @racket[#f] if @racket[pos]
refers to the last element in @racket[hash]. If @racket[pos] is not a
valid index, then the @exnraise[exn:fail:contract]. For a mutable
@racket[hash], the result index is guaranteed to refer to its item
only as long as no items are added to or removed from @racket[hash].}
refers to the last element in @racket[hash].
If @racket[pos] is not a @tech{valid hash index} of @racket[hash],
then the result may be @racket[#f] or it may be the next later index
that remains valid. The latter result is guaranteed if a hash table
has been modified only by the removal of keys.
@history[#:changed "7.0.0.10" @elem{Handle an invalid index by returning @scheme[#f]
instead of raising @racket[exn:fail:contract].}]}
@deftogether[(
@defproc[(hash-iterate-key [hash hash?]
[pos exact-nonnegative-integer?])
any]{
any/c]
@defproc[#:link-target? #f
(hash-iterate-key [hash hash?]
[pos exact-nonnegative-integer?]
[bad-index-v any/c])
any/c]
)]{
Returns the key 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].}
@racket[pos].
If @racket[pos] is not a @tech{valid hash index} for @racket[hash],
the result is @racket[bad-index-v] if provided, otherwise the
@exnraise[exn:fail:contract].
@history[#:changed "7.0.0.10" @elem{Added the optional @racket[bad-index-v] argument.}]}
@deftogether[(
@defproc[(hash-iterate-value [hash hash?]
[pos exact-nonnegative-integer?])
any]{
any]
@defproc[#:link-target? #f
(hash-iterate-value [hash hash?]
[pos exact-nonnegative-integer?]
[bad-index-v any/c])
any]
)]{
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].}
@racket[pos].
If @racket[pos] is not a @tech{valid hash index} for @racket[hash],
the result is @racket[bad-index-v] if provided, otherwise the
@exnraise[exn:fail:contract].
@history[#:changed "7.0.0.10" @elem{Added the optional @racket[bad-index-v] argument.}]}
@deftogether[(
@defproc[(hash-iterate-pair [hash hash?]
[pos exact-nonnegative-integer?])
(cons any any)]{
[pos exact-nonnegative-integer?])
(cons any/c any/c)]
@defproc[#:link-target? #f
(hash-iterate-pair [hash hash?]
[pos exact-nonnegative-integer?]
[bad-index-v any/c])
(cons any/c any/c)]
)]{
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].}
in @racket[hash] at index @racket[pos].
@history[#:added "6.4.0.5"]
If @racket[pos] is not a @tech{valid hash index} for @racket[hash],
the result is @racket[(cons bad-index-v bad-index-v)] if
@racket[bad-index-v] is provided, otherwise the
@exnraise[exn:fail:contract].
@history[#:added "6.4.0.5"
#:changed "7.0.0.10" @elem{Added the optional @racket[bad-index-v] argument.}]}
@deftogether[(
@defproc[(hash-iterate-key+value [hash hash?]
[pos exact-nonnegative-integer?])
(values any any)]{
[pos exact-nonnegative-integer?])
(values any/c any/c)]
@defproc[#:link-target? #f
(hash-iterate-key+value [hash hash?]
[pos exact-nonnegative-integer?]
[bad-index-v any/c])
(values any/c any/c)]
)]{
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].}
@racket[pos].
If @racket[pos] is not a @tech{valid hash index} for @racket[hash],
the result is @racket[(values bad-index-v bad-index-v)] if
@racket[bad-index-v] is provided, otherwise the
@exnraise[exn:fail:contract].
@history[#:added "6.4.0.5"
#:changed "7.0.0.10" @elem{Added the optional @racket[bad-index-v] argument.}]}
@history[#:added "6.4.0.5"]
@defproc[(hash-copy [hash hash?])
(and/c hash? (not/c immutable?))]{

103
pkgs/racket-doc/scribblings/reference/sequences.scrbl
View File

@ -349,8 +349,19 @@ each element in the sequence.
that the default mode is @racket['any], whereas the default mode of
@racket[read-bytes-line] is @racket['linefeed].}
@defproc[(in-hash [hash hash?]) sequence?]{
Returns a sequence equivalent to @racket[hash].
@defproc*[([(in-hash [hash hash?]) sequence?]
[(in-hash [hash hash?] [bad-index-v any/c]) sequence?])]{
Returns a sequence equivalent to @racket[hash], except when @racket[bad-index-v]
is supplied.
If @racket[bad-index-v] is supplied, then @racket[bad-index-v] is
returned as both the key and the value in the case that the
@racket[hash] is modified concurrently so that iteration does not have a
@tech{valid hash index}. Providing @racket[bad-index-v] is particularly
useful when iterating through a hash table with weakly held keys, since
entries can be removed asynchronously (i.e., after @racket[in-hash] has
committed to another iteration, but before it can access the entry for the
next iteration).
@examples[
(define table (hash 'a 1 'b 2))
@ -358,82 +369,144 @@ each element in the sequence.
(printf "key: ~a value: ~a\n" key value))]
@info-on-seq["hashtables" "hash tables"]
}
@defproc[(in-hash-keys [hash hash?]) sequence?]{
Returns a sequence whose elements are the keys of @racket[hash].
@history[#:changed "7.0.0.10" @elem{Added the optional @racket[bad-index-v] argument.}]}
@defproc*[([(in-hash-keys [hash hash?]) sequence?]
[(in-hash-keys [hash hash?] [bad-index-v any/c]) sequence?])]{
Returns a sequence whose elements are the keys of @racket[hash], using
@racket[bad-index-v] in the same way as @racket[in-hash].
@examples[
(define table (hash 'a 1 'b 2))
(for ([key (in-hash-keys table)])
(printf "key: ~a\n" key))]
}
@defproc[(in-hash-values [hash hash?]) sequence?]{
Returns a sequence whose elements are the values of @racket[hash].
@history[#:changed "7.0.0.10" @elem{Added the optional @racket[bad-index-v] argument.}]}
@defproc*[([(in-hash-values [hash hash?]) sequence?]
[(in-hash-values [hash hash?] [bad-index-v any/c]) sequence?])]{
Returns a sequence whose elements are the values of @racket[hash], using
@racket[bad-index-v] in the same way as @racket[in-hash].
@examples[
(define table (hash 'a 1 'b 2))
(for ([value (in-hash-values table)])
(printf "value: ~a\n" value))]
}
@defproc[(in-hash-pairs [hash hash?]) sequence?]{
@history[#:changed "7.0.0.10" @elem{Added the optional @racket[bad-index-v] argument.}]}
@defproc*[([(in-hash-pairs [hash hash?]) sequence?]
[(in-hash-pairs [hash hash?] [bad-index-v any/c]) sequence?])]{
Returns a sequence whose elements are pairs, each containing a key
and its value from @racket[hash] (as opposed to using @racket[hash]
directly as a sequence to get the key and value as separate values
for each element).
for each element).
The @racket[bad-index-v] argument, if supplied, is used in the same
way as by @racket[in-hash]. When an invalid index is encountered,
the pair in the sequence with have @racket[bad-index-v] as both its
@racket[car] and @racket[cdr].
@examples[
(define table (hash 'a 1 'b 2))
(for ([key+value (in-hash-pairs table)])
(printf "key and value: ~a\n" key+value))]
}
@history[#:changed "7.0.0.10" @elem{Added the optional @racket[bad-index-v] argument.}]}
@deftogether[(
@defproc[(in-mutable-hash
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))])
sequence?]
@defproc[#:link-target? #f
(in-mutable-hash
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))] [bad-index-v any/c])
sequence?]
@defproc[(in-mutable-hash-keys
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))])
sequence?]
@defproc[#:link-target? #f
(in-mutable-hash-keys
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))] [bad-index-v any/c])
sequence?]
@defproc[(in-mutable-hash-values
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))])
sequence?]
@defproc[#:link-target? #f
(in-mutable-hash-values
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))] [bad-index-v any/c])
sequence?]
@defproc[(in-mutable-hash-pairs
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))])
sequence?]
@defproc[#:link-target? #f
(in-mutable-hash-pairs
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))] [bad-index-v any/c])
sequence?]
@defproc[(in-immutable-hash
[hash (and/c hash? immutable?)])
sequence?]
@defproc[#:link-target? #f
(in-immutable-hash
[hash (and/c hash? immutable?)] [bad-index-v any/c])
sequence?]
@defproc[(in-immutable-hash-keys
[hash (and/c hash? immutable?)])
sequence?]
@defproc[#:link-target? #f
(in-immutable-hash-keys
[hash (and/c hash? immutable?)] [bad-index-v any/c])
sequence?]
@defproc[(in-immutable-hash-values
[hash (and/c hash? immutable?)])
sequence?]
@defproc[#:link-target? #f
(in-immutable-hash-values
[hash (and/c hash? immutable?)] [bad-index-v any/c])
sequence?]
@defproc[(in-immutable-hash-pairs
[hash (and/c hash? immutable?)])
sequence?]
@defproc[#:link-target? #f
(in-immutable-hash-pairs
[hash (and/c hash? immutable?)] [bad-index-v any/c])
sequence?]
@defproc[(in-weak-hash
[hash (and/c hash? hash-weak?)])
sequence?]
@defproc[#:link-target? #f
(in-weak-hash
[hash (and/c hash? hash-weak?)] [bad-index-v any/c])
sequence?]
@defproc[(in-weak-hash-keys
[hash (and/c hash? hash-weak?)])
sequence?]
@defproc[#:link-target? #f
(in-weak-hash-keys
[hash (and/c hash? hash-weak?)] [bad-index-v any/c])
sequence?]
@defproc[(in-weak-hash-values
[hash (and/c hash? hash-weak?)])
sequence?]
@defproc[#:link-target? #f
(in-weak-hash-keys
[hash (and/c hash? hash-weak?)] [bad-index-v any/c])
sequence?]
@defproc[(in-weak-hash-pairs
[hash (and/c hash? hash-weak?)])
sequence?]
@defproc[#:link-target? #f
(in-weak-hash-pairs
[hash (and/c hash? hash-weak?)] [bad-index-v any/c])
sequence?]
)]{
Sequence constructors for specific kinds of hash tables.
These may perform better than the analogous @racket[in-hash]
forms. However, they may consume more space to help with iteration.
forms.
@history[#:added "6.4.0.6"]
@history[#:added "6.4.0.6"
#:changed "7.0.0.10" @elem{Added the optional @racket[bad-index-v] argument.}]
}

169
pkgs/racket-doc/scribblings/reference/unsafe.scrbl
View File

@ -356,91 +356,168 @@ is analogous to @racket[box-cas!] to perform an atomic compare-and-set.
@deftogether[(
@defproc[(unsafe-mutable-hash-iterate-first
[h (and/c hash? (not/c immutable?) (not/c hash-weak?))])
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))])
(or/c #f any/c)]
@defproc[(unsafe-mutable-hash-iterate-next
[h (and/c hash? (not/c immutable?) (not/c hash-weak?))]
[i any/c])
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))]
[pos any/c])
(or/c #f any/c)]
@defproc[(unsafe-mutable-hash-iterate-key
[h (and/c hash? (not/c immutable?) (not/c hash-weak?))]
[i any/c])
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))]
[pos any/c])
any/c]
@defproc[#:link-target? #f
(unsafe-mutable-hash-iterate-key
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))]
[pos any/c]
[bad-index-v any/c])
any/c]
@defproc[(unsafe-mutable-hash-iterate-value
[h (and/c hash? (not/c immutable?) (not/c hash-weak?))]
[i any/c])
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))]
[pos any/c])
any/c]
@defproc[#:link-target? #f
(unsafe-mutable-hash-iterate-value
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))]
[pos any/c]
[bad-index-v any/c])
any/c]
@defproc[(unsafe-mutable-hash-iterate-key+value
[h (and/c hash? (not/c immutable?) (not/c hash-weak?))]
[i any/c])
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))]
[pos any/c])
(values any/c any/c)]
@defproc[#:link-target? #f
(unsafe-mutable-hash-iterate-key+value
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))]
[pos any/c]
[bad-index-v any/c])
(values any/c any/c)]
@defproc[(unsafe-mutable-hash-iterate-pair
[h (and/c hash? (not/c immutable?) (not/c hash-weak?))]
[i any/c])
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))]
[pos any/c])
pair?]
@defproc[#:link-target? #f
(unsafe-mutable-hash-iterate-pair
[hash (and/c hash? (not/c immutable?) (not/c hash-weak?))]
[pos any/c]
[bad-index-v any/c])
pair?]
@defproc[(unsafe-immutable-hash-iterate-first
[h (and/c hash? immutable?)])
[hash (and/c hash? immutable?)])
(or/c #f any/c)]
@defproc[(unsafe-immutable-hash-iterate-next
[h (and/c hash? immutable?)]
[i any/c])
[hash (and/c hash? immutable?)]
[pos any/c])
(or/c #f any/c)]
@defproc[(unsafe-immutable-hash-iterate-key
[h (and/c hash? immutable?)]
[i any/c])
[hash (and/c hash? immutable?)]
[pos any/c])
any/c]
@defproc[#:link-target? #f
(unsafe-immutable-hash-iterate-key
[hash (and/c hash? immutable?)]
[pos any/c]
[bad-index-v any/c])
any/c]
@defproc[(unsafe-immutable-hash-iterate-value
[h (and/c hash? immutable?)]
[i any/c])
[hash (and/c hash? immutable?)]
[pos any/c])
any/c]
@defproc[#:link-target? #f
(unsafe-immutable-hash-iterate-value
[hash (and/c hash? immutable?)]
[pos any/c]
[bad-index-v any/c])
any/c]
@defproc[(unsafe-immutable-hash-iterate-key+value
[h (and/c hash? immutable?)]
[i any/c])
[hash (and/c hash? immutable?)]
[pos any/c])
(values any/c any/c)]
@defproc[#:link-target? #f
(unsafe-immutable-hash-iterate-key+value
[hash (and/c hash? immutable?)]
[pos any/c]
[bad-index-v any/c])
(values any/c any/c)]
@defproc[(unsafe-immutable-hash-iterate-pair
[h (and/c hash? immutable?)]
[i any/c])
[hash (and/c hash? immutable?)]
[pos any/c])
pair?]
@defproc[#:link-target? #f
(unsafe-immutable-hash-iterate-pair
[hash (and/c hash? immutable?)]
[pos any/c]
[bad-index-v any/c])
pair?]
@defproc[(unsafe-weak-hash-iterate-first
[h (and/c hash? hash-weak?)])
[hash (and/c hash? hash-weak?)])
(or/c #f any/c)]
@defproc[(unsafe-weak-hash-iterate-next
[h (and/c hash? hash-weak?)]
[i any/c])
[hash (and/c hash? hash-weak?)]
[pos any/c])
(or/c #f any/c)]
@defproc[(unsafe-weak-hash-iterate-key
[h (and/c hash? hash-weak?)]
[i any/c])
[hash (and/c hash? hash-weak?)]
[pos any/c])
any/c]
@defproc[#:link-target? #f
(unsafe-weak-hash-iterate-key
[hash (and/c hash? hash-weak?)]
[pos any/c]
[bad-index-v any/c])
any/c]
@defproc[(unsafe-weak-hash-iterate-value
[h (and/c hash? hash-weak?)]
[i any/c])
[hash (and/c hash? hash-weak?)]
[pos any/c])
any/c]
@defproc[#:link-target? #f
(unsafe-weak-hash-iterate-value
[hash (and/c hash? hash-weak?)]
[pos any/c]
[bad-index-v any/c])
any/c]
@defproc[(unsafe-weak-hash-iterate-key+value
[h (and/c hash? hash-weak?)]
[i any/c])
[hash (and/c hash? hash-weak?)]
[pos any/c])
(values any/c any/c)]
@defproc[#:link-target? #f
(unsafe-weak-hash-iterate-key+value
[hash (and/c hash? hash-weak?)]
[pos any/c]
[bad-index-v any/c])
(values any/c any/c)]
@defproc[(unsafe-weak-hash-iterate-pair
[h (and/c hash? hash-weak?)]
[i any/c])
[hash (and/c hash? hash-weak?)]
[pos any/c])
pair?]
@defproc[#:link-target? #f
(unsafe-weak-hash-iterate-pair
[hash (and/c hash? hash-weak?)]
[pos any/c]
[bad-index-v any/c])
pair?]
)]{
Unsafe versions of @racket[hash-iterate-key] and similar ops. These operations
support @tech{chaperones} and @tech{impersonators}.
Unsafe versions of @racket[hash-iterate-key] and similar procedures.
These operations support @tech{chaperones} and @tech{impersonators}.
Each unsafe @code{-first} and @code{-next} operation may not return a number
index but rather an internal representation of a view into the hash structure,
enabling faster iteration.
Each unsafe ...@code{-first} and ...@code{-next} procedure may return,
instead of a number index, an internal representation of a view into
the hash structure, enabling faster iteration. The result of these
...@code{-first} and ...@code{-next} functions should be given as
@racket[pos] to the corresponding unsafe accessor functions.
The result of these @code{-first} and @code{-next}] functions should be given
to the corresponding unsafe accessor functions.
If the @racket[pos] provided to an accessor function for a mutable
@racket[hash] was formerly a @tech{valid hash index} but is no longer
a @tech{valid hash index} for @racket[hash], and if
@racket[bad-index-v] is not provided, then the
@exnraise[exn:fail:contract]. No behavior is specified for a
@racket[pos] that was never a @tech{valid hash index} for
@racket[hash]. Note that @racket[bad-index-v] argument is technically
not useful for the @code{unsafe-immutable-hash-iterate-} functions,
since an index cannot become invalid for an immutable @racket[hash].
If the key or value at the position returned by the @code{-first} and
@code{-next} ops becomes invalid (e.g., because of mutation or garbage
collection), then the operations @exnraise[exn:fail:contract].
@history[#:added "6.4.0.6"]
}
@history[#:added "6.4.0.6"
#:changed "7.0.0.10" @elem{Added the optional @racket[bad-index-v] argument.}]}
@; ------------------------------------------------------------------------

49
pkgs/racket-test-core/tests/racket/basic.rktl
View File

@ -2597,18 +2597,45 @@
(test #f hash-iterate-first (make-hasheq))
(test #f hash-iterate-first (make-weak-hasheq))
(err/rt-test (hash-iterate-next (make-hasheq) 0))
(err/rt-test (hash-iterate-next (make-weak-hasheq) 0))
(test #f hash-iterate-next (make-hasheq) 0)
(test #f hash-iterate-next (make-weak-hasheq) 0)
(let ([check-all-bad
(lambda (op)
(err/rt-test (op #f 0))
(err/rt-test (op (make-hasheq) -1))
(err/rt-test (op (make-hasheq) (- (expt 2 100))))
(err/rt-test (op (make-hasheq) 1.0)))])
(check-all-bad hash-iterate-next)
(check-all-bad hash-iterate-key)
(check-all-bad hash-iterate-value))
(let ([hts (list (make-hash)
(make-hasheq)
(make-hasheqv)
(make-weak-hash)
(make-weak-hasheq)
(make-weak-hasheqv)
(hash)
(hasheq)
(hasheqv))])
(let* ([check-all-bad
(lambda (op)
(err/rt-test (op #f 0))
(err/rt-test (op (make-hasheq) -1))
(err/rt-test (op (make-hasheq) (- (expt 2 100))))
(err/rt-test (op (make-hasheq) 1.0)))]
[check-all-bad-v
(lambda (op)
(check-all-bad op)
(for ([ht (in-list hts)])
(test 'nope op ht 17 'nope)))]
[check-all-bad-pair
(lambda (op)
(check-all-bad op)
(for ([ht (in-list hts)])
(test '(nope . nope) op ht 17 'nope)))]
[check-all-bad-values
(lambda (op)
(check-all-bad op)
(for ([ht (in-list hts)])
(test-values '(nope nope)
(lambda () (op ht 17 'nope)))))])
(check-all-bad hash-iterate-next)
(check-all-bad-v hash-iterate-key)
(check-all-bad-v hash-iterate-value)
(check-all-bad-pair hash-iterate-pair)
(check-all-bad-values hash-iterate-key+value)))
(test (list 1 2 3) sort (hash-keys #hasheq((1 . a) (2 . b) (3 . c))) <)
(test (list 'a 'b 'c)

9
pkgs/racket-test-core/tests/racket/for.rktl
View File

@ -645,6 +645,15 @@
exn:fail:contract:arity?
#rx"expected number of values not received")
(err/rt-test (for ([x (in-hash 1 2 3)]) x)
exn:fail:contract:arity?)
(err/rt-test (for ([x (in-hash-keys 1 2 3)]) x)
exn:fail:contract:arity?)
(err/rt-test (for ([x (in-hash-values 1 2 3)]) x)
exn:fail:contract:arity?)
(err/rt-test (for ([x (in-hash-pairs 1 2 3)]) x)
exn:fail:contract:arity?)
(err/rt-test (for/sum ([x (in-vector (vector 1 2) 2 -1 -1)]) x) ; pr 15227
exn:fail:contract?
#rx"starting index is out of range")

67
pkgs/racket-test-core/tests/racket/hash.rktl
View File

@ -5,6 +5,8 @@
(require racket/hash)
;; ----------------------------------------
(test #hash([4 . four] [3 . three] [1 . one] [2 . two])
hash-union #hash([1 . one] [2 . two]) #hash([3 . three] [4 . four]))
(test #hash([four . 4] [three . 3] [one . 1] [two . 2])
@ -295,16 +297,16 @@
(test #t equal?
(call-with-values (lambda () (hash-iterate-key+value ht i)) cons)
'((1 2 3 4 5 6 7 8 9 10) . val))
(test #t boolean? (hash-iterate-next ht i))
(test #f hash-iterate-next ht i)
;; collect key, everything should error
(collect-garbage)(collect-garbage)(collect-garbage)
(collect-garbage)
(test #t boolean? (hash-iterate-first ht))
(err/rt-test (hash-iterate-key ht i) exn:fail:contract? err-msg)
(err/rt-test (hash-iterate-value ht i) exn:fail:contract? err-msg)
(err/rt-test (hash-iterate-pair ht i) exn:fail:contract? err-msg)
(err/rt-test (hash-iterate-key+value ht i) exn:fail:contract? err-msg)
(err/rt-test (hash-iterate-next ht i) exn:fail:contract? err-msg))
(test #f hash-iterate-next ht i))
;; Check that unsafe mutable hash table operations do not segfault
;; after getting valid index from unsafe-mutable-hash-iterate-first and -next.
@ -331,7 +333,7 @@
(err/rt-test (hash-iterate-value ht i) exn:fail:contract? err-msg)
(err/rt-test (hash-iterate-pair ht i) exn:fail:contract? err-msg)
(err/rt-test (hash-iterate-key+value ht i) exn:fail:contract? err-msg)
(err/rt-test (hash-iterate-next ht i) exn:fail:contract? err-msg))
(test #f hash-iterate-next ht i))
(let ()
@ -356,6 +358,61 @@
(err/rt-test (hash-iterate-value ht i) exn:fail:contract?)
(err/rt-test (hash-iterate-pair ht i) exn:fail:contract?)
(err/rt-test (hash-iterate-key+value ht i) exn:fail:contract?)
(err/rt-test (hash-iterate-next ht i) exn:fail:contract?)))
(test #f hash-iterate-next ht i)))
;; ----------------------------------------
(define-syntax-rule (hash-remove-iterate-test make-hash (X ...) in-hash-X sel)
(let ([ht (make-hash)])
(arity-test in-hash-X 1 2)
(test 'in-hash-X object-name in-hash-X)
(define keys (for/list ([k (in-range 10)])
(gensym)))
(define (add-keys!)
(for ([k (in-list keys)]
[i (in-naturals)])
(hash-set! ht k i)))
(add-keys!)
(test 5 '(remove-during-loop make-hash in-hash-X)
(for/sum ([(X ...) (in-hash-X ht #f)]
[i (in-naturals)])
(when (= i 4)
(for ([k (in-list keys)])
(hash-remove! ht k)))
(if (sel X ...) 1 0)))
(add-keys!)
(test 'ok '(remove-during-loop make-hash in-hash-X)
(for/fold ([v 'ok]) ([(X ...) (in-hash-X ht #f)]
[i (in-naturals)])
(when (= i 4)
(set! keys #f)
(collect-garbage))
v))))
(define-syntax-rule (hash-remove-iterate-test* [make-hash ...] (X ...) in-hash-X in-Y-hash-X sel)
(begin
(hash-remove-iterate-test make-hash (X ...) in-hash-X sel) ...
(hash-remove-iterate-test make-hash (X ...) in-Y-hash-X sel) ...))
(hash-remove-iterate-test* [make-hash make-hasheq make-hasheqv]
(k v) in-hash in-mutable-hash and)
(hash-remove-iterate-test* [make-hash make-hasheq make-hasheqv]
(k) in-hash-keys in-mutable-hash-keys values)
(hash-remove-iterate-test* [make-hash make-hasheq make-hasheqv]
(v) in-hash-values in-mutable-hash-values values)
(hash-remove-iterate-test* [make-hash make-hasheq make-hasheqv]
(p) in-hash-pairs in-mutable-hash-pairs car)
(hash-remove-iterate-test* [make-weak-hash make-weak-hasheq make-weak-hasheqv]
(k v) in-hash in-weak-hash and)
(hash-remove-iterate-test* [make-weak-hash make-weak-hasheq make-weak-hasheqv]
(k) in-hash-keys in-weak-hash-keys values)
(hash-remove-iterate-test* [make-weak-hash make-weak-hasheq make-weak-hasheqv]
(v) in-hash-values in-weak-hash-values values)
(hash-remove-iterate-test* [make-weak-hash make-weak-hasheq make-weak-hasheqv]
(p) in-hash-pairs in-weak-hash-pairs car)
;; ----------------------------------------
(report-errs)

59
pkgs/racket-test-core/tests/racket/unsafe.rktl
View File

@ -634,16 +634,15 @@
;; collect key, everything should error (but not segfault)
(collect-garbage)(collect-garbage)(collect-garbage)
(test #t boolean? (unsafe-weak-hash-iterate-first ht))
(err/rt-test
(unsafe-weak-hash-iterate-key ht i) exn:fail:contract? err-msg)
(err/rt-test
(unsafe-weak-hash-iterate-value ht i) exn:fail:contract? err-msg)
(err/rt-test
(unsafe-weak-hash-iterate-pair ht i) exn:fail:contract? err-msg)
(err/rt-test
(unsafe-weak-hash-iterate-key+value ht i) exn:fail:contract? err-msg)
(err/rt-test
(unsafe-weak-hash-iterate-next ht i) exn:fail:contract? err-msg))
(err/rt-test (unsafe-weak-hash-iterate-key ht i) exn:fail:contract? err-msg)
(test 'gone unsafe-weak-hash-iterate-key ht i 'gone)
(err/rt-test (unsafe-weak-hash-iterate-value ht i) exn:fail:contract? err-msg)
(test 'gone unsafe-weak-hash-iterate-value ht i 'gone)
(err/rt-test (unsafe-weak-hash-iterate-pair ht i) exn:fail:contract? err-msg)
(test '(gone . gone) unsafe-weak-hash-iterate-pair ht i 'gone)
(err/rt-test (unsafe-weak-hash-iterate-key+value ht i) exn:fail:contract? err-msg)
(test-values '(gone gone) (lambda () (unsafe-weak-hash-iterate-key+value ht i 'gone)))
(test #f unsafe-weak-hash-iterate-next ht i))
;; Check that unsafe mutable hash table operations do not segfault
;; after getting valid index from unsafe-mutable-hash-iterate-first and -next.
@ -661,21 +660,20 @@
(call-with-values
(lambda () (unsafe-mutable-hash-iterate-key+value ht i)) cons)
'(a . b))
(test #t boolean? (unsafe-mutable-hash-iterate-next ht i))
(test #f unsafe-mutable-hash-iterate-next ht i)
;; remove element, everything should error (but not segfault)
(hash-remove! ht 'a)
(test #t boolean? (unsafe-mutable-hash-iterate-first ht))
(err/rt-test
(unsafe-mutable-hash-iterate-key ht i) exn:fail:contract? err-msg)
(err/rt-test
(unsafe-mutable-hash-iterate-value ht i) exn:fail:contract? err-msg)
(err/rt-test
(unsafe-mutable-hash-iterate-pair ht i) exn:fail:contract? err-msg)
(err/rt-test
(unsafe-mutable-hash-iterate-key+value ht i) exn:fail:contract? err-msg)
(err/rt-test
(unsafe-mutable-hash-iterate-next ht i) exn:fail:contract? err-msg))
(err/rt-test (unsafe-mutable-hash-iterate-key ht i) exn:fail:contract? err-msg)
(test 'gone unsafe-mutable-hash-iterate-key ht i 'gone)
(err/rt-test (unsafe-mutable-hash-iterate-value ht i) exn:fail:contract? err-msg)
(test 'gone unsafe-mutable-hash-iterate-value ht i 'gone)
(err/rt-test (unsafe-mutable-hash-iterate-pair ht i) exn:fail:contract? err-msg)
(test '(gone . gone) unsafe-mutable-hash-iterate-pair ht i 'gone)
(err/rt-test (unsafe-mutable-hash-iterate-key+value ht i) exn:fail:contract? err-msg)
(test-values '(gone gone) (lambda () (unsafe-mutable-hash-iterate-key+value ht i 'gone)))
(test #f unsafe-mutable-hash-iterate-next ht i))
(let ()
(define ht (make-weak-hash '((a . b))))
@ -695,16 +693,15 @@
;; remove element, everything should error (but not segfault)
(hash-remove! ht 'a)
(test #t boolean? (unsafe-weak-hash-iterate-first ht))
(err/rt-test
(unsafe-weak-hash-iterate-key ht i) exn:fail:contract? err-msg)
(err/rt-test
(unsafe-weak-hash-iterate-value ht i) exn:fail:contract? err-msg)
(err/rt-test
(unsafe-weak-hash-iterate-pair ht i) exn:fail:contract? err-msg)
(err/rt-test
(unsafe-weak-hash-iterate-key+value ht i) exn:fail:contract? err-msg)
(err/rt-test
(unsafe-weak-hash-iterate-next ht i) exn:fail:contract? err-msg)))
(err/rt-test (unsafe-weak-hash-iterate-key ht i) exn:fail:contract? err-msg)
(test 'gone unsafe-weak-hash-iterate-key ht i 'gone)
(err/rt-test (unsafe-weak-hash-iterate-value ht i) exn:fail:contract? err-msg)
(test 'gone unsafe-weak-hash-iterate-value ht i 'gone)
(err/rt-test (unsafe-weak-hash-iterate-pair ht i) exn:fail:contract? err-msg)
(test '(gone . gone) unsafe-weak-hash-iterate-pair ht i 'gone)
(err/rt-test (unsafe-weak-hash-iterate-key+value ht i) exn:fail:contract? err-msg)
(test-values '(gone gone) (lambda () (unsafe-weak-hash-iterate-key+value ht i 'gone)))
(test #f unsafe-weak-hash-iterate-next ht i)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

89
racket/collects/racket/private/for.rkt
View File

@ -734,14 +734,24 @@
;; hash sequences
;; assembles hash iterator functions to give to make-do-sequence
(define (:hash-gen ht -get -first -next)
(values (lambda (pos) (-get ht pos))
#f
(lambda (pos) (-next ht pos))
(-first ht)
(lambda (pos) pos) ; #f position means stop
#f
#f))
(define :hash-gen
(case-lambda
[(ht -get -first -next)
(values (lambda (pos) (-get ht pos))
#f
(lambda (pos) (-next ht pos))
(-first ht)
(lambda (pos) pos) ; #f position means stop
#f
#f)]
[(ht -get -first -next bad-v)
(values (lambda (pos) (-get ht pos bad-v))
#f
(lambda (pos) (-next ht pos))
(-first ht)
(lambda (pos) pos) ; #f position means stop
#f
#f)]))
(define (mutable? ht) (not (immutable? ht)))
(define (not-weak? ht) (not (hash-weak? ht)))
@ -796,34 +806,47 @@
(define (CHECK-SEQ ht)
(unless (HASHTYPE? ht)
(raise-argument-error 'IN-HASH-SEQ ERR-STR ht))))
(define (AS-EXPR-SEQ ht)
(CHECK-SEQ ht)
(make-do-sequence (lambda () (:hash-gen ht -VAL -first -next))))
(define AS-EXPR-SEQ
(let ([IN-HASH-SEQ
(case-lambda
[(ht)
(CHECK-SEQ ht)
(make-do-sequence (lambda () (:hash-gen ht -VAL -first -next)))]
[(ht bad-v)
(CHECK-SEQ ht)
(make-do-sequence (lambda () (:hash-gen ht -VAL -first -next bad-v)))])])
IN-HASH-SEQ))
(define-sequence-syntax IN-HASH-SEQ
(lambda () #'AS-EXPR-SEQ)
(lambda (stx)
(syntax-case stx ()
[[(V ...) (_ ht-expr)]
(for-clause-syntax-protect
#'[(V ...)
(:do-in
;;outer bindings
([(ht) ht-expr])
;; outer check
(unless-unsafe (CHECK-SEQ ht))
;; loop bindings
([i (-first ht)])
;; pos check
i
;; inner bindings
([(V ...) (-VAL ht i)])
;; pre guard
#t
;; post guard
#t
;; loop args
((-next ht i)))])]
[_ #f]))))))]))
(define (transform stx)
(syntax-case stx ()
[[(V ...) (_ ht-expr . extra-args)]
(for-clause-syntax-protect
#'[(V ...)
(:do-in
;;outer bindings
([(ht) ht-expr])
;; outer check
(unless-unsafe (CHECK-SEQ ht))
;; loop bindings
([i (-first ht)])
;; pos check
i
;; inner bindings
([(V ...) (-VAL ht i . extra-args)])
;; pre guard
#t
;; post guard
#t
;; loop args
((-next ht i)))])]))
(syntax-case stx ()
[[(V ...) (_ ht-expr)]
(transform stx)]
[[(V ...) (_ ht-expr bad-index-expr)]
(transform stx)]
[_ #f]))))))]))
;; 2) define sequence syntaxes (using just-defined definer):
(IN-HASH-DEFINER hash-type: hash)
(IN-HASH-DEFINER hash-type: mutable-hash checks: mutable? not-weak?)

414
racket/src/cs/rumble/hash.ss
View File

@ -1,9 +1,17 @@
;; Mutable and weak-equal hash tables need a lock
;; and an iteration vector
(define-record locked-iterable-hash (lock
cells ; vector of cells for iteration
retry?)) ; is `cells` maybe incomplete?
;; To support iteration and locking, we wrap Chez's mutable hash
;; tables in a `mutable-hash` record:
(define-record mutable-hash (ht ; Chez Scheme hashtable
cells ; vector of keys for iteration
lock))
(define (create-mutable-hash ht kind) (make-mutable-hash ht #f (make-lock kind)))
;; tables in a `mutable-hash` record
(define-record mutable-hash locked-iterable-hash
(ht)) ; Chez Scheme hashtable
(define (create-mutable-hash ht kind) (make-mutable-hash (make-lock kind) #f #f ht))
(define (mutable-hash-lock ht) (locked-iterable-hash-lock ht))
(define (mutable-hash-cells ht) (locked-iterable-hash-cells ht))
(define (authentic-hash? v) (or (intmap? v) (mutable-hash? v) (weak-equal-hash? v)))
(define (hash? v) (or (authentic-hash? v)
@ -74,10 +82,8 @@
(cond
[(mutable-hash? ht)
(lock-acquire (mutable-hash-lock ht))
(when (and (mutable-hash-cells ht)
(not (hashtable-contains? (mutable-hash-ht ht) k)))
(set-mutable-hash-cells! ht #f))
(hashtable-set! (mutable-hash-ht ht) k v)
(set-locked-iterable-hash-retry?! ht #t)
(lock-release (mutable-hash-lock ht))]
[(weak-equal-hash? ht) (weak-hash-set! ht k v)]
[(and (impersonator? ht)
@ -96,9 +102,10 @@
(hashtable-contains? (mutable-hash-ht ht) k))
(let ([cell (hashtable-cell (mutable-hash-ht ht) k #f)])
(hashtable-delete! (mutable-hash-ht ht) k)
;; Clear cell, because it may be in `(mutable-hash-cells ht)`
;; Clear cell, because it may be in `(locked-iterable-hash-cells ht)`
(set-car! cell #!bwp)
(set-cdr! cell #!bwp))]
(set-cdr! cell #!bwp)
(set-locked-iterable-hash-retry?! ht #t))]
[else
(hashtable-delete! (mutable-hash-ht ht) k)])
(lock-release (mutable-hash-lock ht))]
@ -114,7 +121,7 @@
(cond
[(mutable-hash? ht)
(lock-acquire (mutable-hash-lock ht))
(set-mutable-hash-cells! ht #f)
(set-locked-iterable-hash-cells! ht #f)
(hashtable-clear! (mutable-hash-ht ht))
(lock-release (mutable-hash-lock ht))]
[(weak-equal-hash? ht) (weak-hash-clear! ht)]
@ -419,23 +426,35 @@
;; and then get more as needed, so that an N-step traversals
;; is O(N) even if the hash table has more than O(N) entries.
(define (prepare-iterate! ht i)
(lock-acquire (mutable-hash-lock ht))
(let ([vec (mutable-hash-cells ht)])
(lock-acquire (locked-iterable-hash-lock ht))
(let ([vec (locked-iterable-hash-cells ht)])
(cond
[(and vec
(fx> (#%vector-length vec) (or i 0)))
(lock-release (mutable-hash-lock ht))
(let ([len (#%vector-length vec)]
[want-len (or i 0)])
(or (> len want-len)
(and (fx= len want-len)
(not (locked-iterable-hash-retry? ht))))))
(lock-release (locked-iterable-hash-lock ht))
vec]
[else
(let ([vec (cells-merge vec
(hashtable-cells
(mutable-hash-ht ht)
(if vec
(fx* 2 (#%vector-length vec))
32)))])
(set-mutable-hash-cells! ht vec)
(lock-release (mutable-hash-lock ht))
vec)])))
(let ([new-vec (get-locked-iterable-hash-cells
ht
(fxmax (if vec
(fx* 2 (#%vector-length vec))
0)
32))])
(when (= (#%vector-length new-vec) (hash-count ht))
(set-locked-iterable-hash-retry?! ht #f))
(let ([vec (cells-merge vec new-vec)])
(set-locked-iterable-hash-cells! ht vec)
(lock-release (locked-iterable-hash-lock ht))
vec))])))
(define (get-locked-iterable-hash-cells ht n)
(cond
[(mutable-hash? ht) (hashtable-cells (mutable-hash-ht ht) n)]
[else (weak-equal-hash-cells ht n)]))
;; Separate calls to `hashtable-cells` may return the
;; cells in a different order, so we have to merge the
@ -481,9 +500,8 @@
(cond
[(intmap? ht)
(intmap-iterate-first ht)]
[(mutable-hash? ht)
(mutable-hash-iterate-next ht #f)]
[(weak-equal-hash? ht) (weak-hash-iterate-first ht)]
[(locked-iterable-hash? ht)
(locked-iterable-hash-iterate-next ht #f)]
[(and (impersonator? ht)
(authentic-hash? (impersonator-val ht)))
;; `hash-iterate-first` must not hash any keys:
@ -498,25 +516,24 @@
[(intmap? ht)
(check-i 'hash-iterate-next i)
(intmap-iterate-next ht i)]
[(mutable-hash? ht)
[(locked-iterable-hash? ht)
(check-i 'hash-iterate-next i)
(mutable-hash-iterate-next ht i)]
[(weak-equal-hash? ht)
(check-i 'hash-iterate-next i)
(weak-hash-iterate-next ht i)]
(locked-iterable-hash-iterate-next ht i)]
[(and (impersonator? ht)
(authentic-hash? (impersonator-val ht)))
;; `hash-iterate-next` must not hash any keys:
(hash-iterate-next (impersonator-val ht) i)]
[else (raise-argument-error who "hash?" ht)]))
(define (mutable-hash-iterate-next ht init-i)
(define (locked-iterable-hash-iterate-next ht init-i)
(let loop ([i (or init-i -1)])
(let* ([i (add1 i)]
[vec (prepare-iterate! ht i)] ; vec expected to have >= `i` elements
[len (vector-length vec)])
[len (#%vector-length vec)])
(cond
[(> i len)
#f
#;
(raise-arguments-error 'hash-iterate-next "no element at index"
"index" init-i
"within length" len
@ -524,7 +541,7 @@
[(= i len)
#f]
[else
(let* ([p (vector-ref vec i)]
(let* ([p (#%vector-ref vec i)]
[key (car p)])
(cond
[(bwp-object? key)
@ -534,19 +551,21 @@
(define (do-hash-iterate-key+value who ht i
intmap-iterate-key+value
weak-hash-iterate-key+value
key? value? pair?)
key? value? pair?
bad-index-v)
(cond
[(intmap? ht)
(check-i who i)
(call-with-values (lambda () (intmap-iterate-key+value ht i none))
(case-lambda
[(v) (if (eq? v none)
(raise-arguments-error who "no element at index"
"index" i)
(if (eq? bad-index-v none)
(raise-arguments-error who "no element at index"
"index" i)
(bad-index-result key? value? pair? bad-index-v))
v)]
[(k v) (values k v)]))]
[(mutable-hash? ht)
[(locked-iterable-hash? ht)
(check-i who i)
(let* ([vec (prepare-iterate! ht i)]
[len (#%vector-length vec)]
@ -558,8 +577,10 @@
none
(cdr p))])
(if (eq? v none)
(raise-arguments-error who "no element at index"
"index" i)
(if (eq? bad-index-v none)
(raise-arguments-error who "no element at index"
"index" i)
(bad-index-result key? value? pair? bad-index-v))
(cond
[(and key? value?)
(if pair?
@ -567,37 +588,46 @@
(values key v))]
[key? key]
[else v])))]
[(weak-equal-hash? ht)
(check-i who i)
(weak-hash-iterate-key+value ht i)]
[(and (impersonator? ht)
(authentic-hash? (impersonator-val ht)))
(impersonate-hash-iterate-key+value who ht i key? value? pair?)]
(impersonate-hash-iterate-key+value who ht i key? value? pair? bad-index-v)]
[else (raise-argument-error who "hash?" ht)]))
(define (hash-iterate-key ht i)
(do-hash-iterate-key+value 'hash-iterate-key ht i
intmap-iterate-key
weak-hash-iterate-key
#t #f #f))
(define hash-iterate-key
(case-lambda
[(ht i) (hash-iterate-key ht i none)]
[(ht i bad-index-v)
(do-hash-iterate-key+value 'hash-iterate-key ht i
intmap-iterate-key
#t #f #f
bad-index-v)]))
(define (hash-iterate-value ht i)
(do-hash-iterate-key+value 'hash-iterate-value ht i
intmap-iterate-value
weak-hash-iterate-value
#f #t #f))
(define hash-iterate-value
(case-lambda
[(ht i) (hash-iterate-value ht i none)]
[(ht i bad-index-v)
(do-hash-iterate-key+value 'hash-iterate-value ht i
intmap-iterate-value
#f #t #f
bad-index-v)]))
(define (hash-iterate-key+value ht i)
(do-hash-iterate-key+value 'hash-iterate-key+value ht i
intmap-iterate-key+value
weak-hash-iterate-key+value
#t #t #f))
(define hash-iterate-key+value
(case-lambda
[(ht i) (hash-iterate-key+value ht i none)]
[(ht i bad-index-v)
(do-hash-iterate-key+value 'hash-iterate-key+value ht i
intmap-iterate-key+value
#t #t #f
bad-index-v)]))
(define (hash-iterate-pair ht i)
(do-hash-iterate-key+value 'hash-iterate-pair ht i
intmap-iterate-pair
weak-hash-iterate-pair
#t #t #t))
(define hash-iterate-pair
(case-lambda
[(ht i) (hash-iterate-pair ht i none)]
[(ht i bad-index-v)
(do-hash-iterate-key+value 'hash-iterate-pair ht i
intmap-iterate-pair
#t #t #t
bad-index-v)]))
(define (unsafe-immutable-hash-iterate-first ht)
(if (impersonator? ht)
@ -616,20 +646,29 @@
(hash-iterate-key ht i)
(unsafe-intmap-iterate-key ht i)))
(define (unsafe-immutable-hash-iterate-value ht i)
(if (iterator-for-impersonator? i)
(hash-iterate-value ht i)
(unsafe-intmap-iterate-value ht i)))
(define unsafe-immutable-hash-iterate-value
(case-lambda
[(ht i) (unsafe-immutable-hash-iterate-value ht i none)]
[(ht i bad-index-v)
(if (iterator-for-impersonator? i)
(hash-iterate-value ht i bad-index-v)
(unsafe-intmap-iterate-value ht i))]))
(define (unsafe-immutable-hash-iterate-key+value ht i)
(if (iterator-for-impersonator? i)
(hash-iterate-key+value ht i)
(unsafe-intmap-iterate-key+value ht i)))
(define unsafe-immutable-hash-iterate-key+value
(case-lambda
[(ht i) (unsafe-immutable-hash-iterate-key+value ht i none)]
[(ht i bad-index-v)
(if (iterator-for-impersonator? i)
(hash-iterate-key+value ht i bad-index-v)
(unsafe-intmap-iterate-key+value ht i))]))
(define (unsafe-immutable-hash-iterate-pair ht i)
(if (iterator-for-impersonator? i)
(hash-iterate-pair ht i)
(unsafe-intmap-iterate-pair ht i)))
(define unsafe-immutable-hash-iterate-pair
(case-lambda
[(ht i) (unsafe-immutable-hash-iterate-pair ht i none)]
[(ht i bad-index-v)
(if (iterator-for-impersonator? i)
(hash-iterate-pair ht i bad-index-v)
(unsafe-intmap-iterate-pair ht i))]))
(define unsafe-mutable-hash-iterate-first hash-iterate-first)
(define unsafe-mutable-hash-iterate-next hash-iterate-next)
@ -650,26 +689,28 @@
;; Chez Scheme doesn't provide weak hash table with `equal?` comparisons,
;; so build our own
(define-record weak-equal-hash (lock
keys-ht ; integer[equal hash code] -> weak list of keys
vals-ht ; weak, eq?-based hash table: key -> value
count ; number of items in the table (= sum of list lengths)
prune-at ; count at which we should try to prune empty weak boxes
keys)) ; for iteration: a vector that is enlarged on demand
(define-record weak-equal-hash locked-iterable-hash
(keys-ht ; integer[equal hash code] -> weak list of keys
vals-ht ; weak, eq?-based hash table: key -> value
count ; number of items in the table (= sum of list lengths)
prune-at)) ; count at which we should try to prune empty weak boxes
(define (weak-equal-hash-lock t) (locked-iterable-hash-lock t))
(define make-weak-hash
(case-lambda
[() (make-weak-equal-hash (make-lock 'equal?) (hasheqv) (make-weak-eq-hashtable) 0 128 #f)]
[() (make-weak-equal-hash (make-lock 'equal?) #f #f (hasheqv) (make-weak-eq-hashtable) 0 128)]
[(alist) (fill-hash! 'make-weak-hash (make-weak-hash) alist)]))
(define (weak-hash-copy ht)
(lock-acquire (weak-equal-hash-lock ht))
(let ([new-ht (make-weak-equal-hash (weak-equal-hash-lock ht)
#f
#t
(weak-equal-hash-keys-ht ht)
(hashtable-copy (weak-equal-hash-vals-ht ht) #t)
(weak-equal-hash-count ht)
(weak-equal-hash-prune-at ht)
#f)])
(weak-equal-hash-prune-at ht))])
(lock-release (weak-equal-hash-lock ht))
new-ht))
@ -708,12 +749,12 @@
(define (weak-hash-set! t k v)
(let ([code (key-equal-hash-code k)])
(lock-acquire (weak-equal-hash-lock t))
(set-locked-iterable-hash-retry?! t #t)
(let ([keys (intmap-ref (weak-equal-hash-keys-ht t) code '())])
(let loop ([keys keys])
(cond
[(null? keys)
;; Not in the table:
(set-weak-equal-hash-keys! t #f)
(when (= (weak-equal-hash-count t) (weak-equal-hash-prune-at t))
(prune-table! t))
(let* ([ht (weak-equal-hash-keys-ht t)])
@ -734,34 +775,40 @@
(let ([code (key-equal-hash-code k)])
(lock-acquire (weak-equal-hash-lock t))
(let* ([keys (intmap-ref (weak-equal-hash-keys-ht t) code '())]
[keep-bwp?
;; If we have a `keys` array, then preserve the shape of
;; each key lst in `(weak-equal-hash-keys-ht t)` so that
;; the `keys` array remains consistent with that shape
(and (weak-equal-hash-keys t) #t)]
[new-keys
(let loop ([keys keys])
(cond
[(null? keys)
;; Not in the table
#f]
[(key-equal? (car keys) k)
(hashtable-delete! (weak-equal-hash-vals-ht t) (car keys))
(if keep-bwp?
(cons #!bwp keys)
(cdr keys))]
[(let ([a (car keys)])
(and (key-equal? a k)
a))
=> (lambda (a)
(let ([ht (weak-equal-hash-vals-ht t)])
(cond
[(locked-iterable-hash-cells t)
;; Clear cell, because it may be in `(locked-iterable-hash-cells ht)`
(let ([cell (hashtable-cell ht a #f)])
(hashtable-delete! ht a)
(set-car! cell #!bwp)
(set-cdr! cell #!bwp))]
[else
(hashtable-delete! ht a)]))
(cdr keys))]
[else
(let ([new-keys (loop (cdr keys))])
(and new-keys
(if (and (not keep-bwp?)
(bwp-object? (car keys)))
new-keys
(weak/fl-cons (car keys) new-keys))))]))])
(let ([a (car keys)])
(if (bwp-object? a)
new-keys
(weak/fl-cons a new-keys)))))]))])
(when new-keys
(set-weak-equal-hash-keys-ht! t
(if (null? new-keys)
(intmap-remove (weak-equal-hash-keys-ht t) code)
(intmap-set (weak-equal-hash-keys-ht t) code new-keys))))
(set-locked-iterable-hash-retry?! t #t)
(lock-release (weak-equal-hash-lock t)))))
(define (weak-hash-clear! t)
@ -770,7 +817,7 @@
(hashtable-clear! (weak-equal-hash-vals-ht t))
(set-weak-equal-hash-count! t 0)
(set-weak-equal-hash-prune-at! t 128)
(set-weak-equal-hash-keys! t #f)
(set-locked-iterable-hash-cells! t #f)
(lock-release (weak-equal-hash-lock t)))
(define (weak-hash-for-each t proc)
@ -798,122 +845,40 @@
(define (weak-hash-count t)
(hashtable-size (weak-equal-hash-vals-ht t)))
(define (prepare-weak-iterate! ht i)
(let* ([current-vec (weak-equal-hash-keys ht)])
(or (and current-vec
(> (vector-length current-vec) (or i 1))
current-vec)
(let* ([len (max 16
(* 2 (if current-vec
(vector-length current-vec)
0))
(if i (* 2 i) 0))]
[vec (make-vector len #f)]
[pos (box 0)])
(call/cc
(lambda (esc)
(intmap-for-each
(weak-equal-hash-keys-ht ht)
(lambda (k l)
(let loop ([l l])
(cond
[(null? l) (void)]
[else
;; Add `l` even if the key is #!bwp,
;; so that iteration works right if a key
;; is removed
(vector-set! vec (unbox pos) l)
(set-box! pos (add1 (unbox pos)))
(if (= (unbox pos) len)
;; That's enough keys
(esc (void))
(loop (cdr l)))]))))))
(set-weak-equal-hash-keys! ht vec)
vec))))
(define (weak-hash-iterate-first ht)
(weak-hash-iterate-next ht #f))
(define (weak-hash-iterate-next ht init-i)
(lock-acquire (weak-equal-hash-lock ht))
(let retry ([i (and init-i (add1 init-i))])
(let* ([vec (prepare-weak-iterate! ht i)]
[len (vector-length vec)])
(let loop ([i (or i 0)])
(cond
[(= i len)
;; expand set of prepared keys
(retry i)]
[(> i len)
(lock-release (weak-equal-hash-lock ht))
(raise-arguments-error 'hash-iterate-next "no element at weak index"
"index" init-i)]
[else
(let ([p (vector-ref vec i)])
(define (weak-equal-hash-cells ht len)
(let ([vals-ht (weak-equal-hash-vals-ht ht)]
[vec (make-vector len #f)]
[pos (box 0)])
(call/cc
(lambda (esc)
(intmap-for-each
(weak-equal-hash-keys-ht ht)
(lambda (k l)
(let loop ([l l])
(cond
[(not p)
;; no more keys available
(lock-release (weak-equal-hash-lock ht))
#f]
[(bwp-object? (car p)) (loop (add1 i))]
[(not (hashtable-contains? (weak-equal-hash-vals-ht ht) (car p)))
;; key was removed from table after `keys` array was formed
(loop (add1 i))]
[(null? l) (void)]
[else
(lock-release (weak-equal-hash-lock ht))
i]))])))))
(define (do-weak-hash-iterate-key who ht i release-lock?)
(lock-acquire (weak-equal-hash-lock ht))
(let* ([vec (weak-equal-hash-keys ht)]
[p (and vec
(< i (vector-length vec))
(vector-ref vec i))]
[k (if p
(car p)
#!bwp)])
(when release-lock?
(lock-release (weak-equal-hash-lock ht)))
(let ([key (car l)])
(cond
[(eq? #!bwp key) (loop (cdr l))]
[else
(#%vector-set! vec (unbox pos) (hashtable-cell vals-ht key #f))
(set-box! pos (add1 (unbox pos)))
(if (= (unbox pos) len)
;; That's enough keys
(esc (void))
(loop (cdr l)))]))]))))))
;; Resize `vec` if we got fewer than `len` keys
(cond
[(bwp-object? k)
(raise-arguments-error who "no element at index"
"index" i)]
[else k])))
(define (weak-hash-iterate-key ht i)
(do-weak-hash-iterate-key 'hash-iterate-key ht i #t))
(define (weak-hash-iterate-value ht i)
(let* ([key (do-weak-hash-iterate-key 'hash-iterate-value ht i #f)]
[val (hashtable-ref (weak-equal-hash-vals-ht ht) key none)])
(lock-release (weak-equal-hash-lock ht))
(if (eq? val none)
(raise-arguments-error
'weak-hash-iterate-value "no element at index"
"index" i)
val)))
(define (weak-hash-iterate-key+value ht i)
(let ([key (do-weak-hash-iterate-key 'hash-iterate-key+value ht i #f)])
(values key
(let ([val (hashtable-ref (weak-equal-hash-vals-ht ht) key none)])
(lock-release (weak-equal-hash-lock ht))
(if (eq? val none)
(raise-arguments-error
'weak-hash-iterate-key+value "no element at index"
"index" i)
val)))))
(define (weak-hash-iterate-pair ht i)
(let ([key (do-weak-hash-iterate-key 'hash-iterate-pair ht i #f)])
(cons key
(let ([val (hashtable-ref (weak-equal-hash-vals-ht ht) key none)])
(lock-release (weak-equal-hash-lock ht))
(if (eq? val none)
(raise-arguments-error
'weak-hash-iterate-paur "no element at index"
"index" i)
val)))))
[(< (unbox pos) len)
(let* ([len (unbox pos)]
[compact-vec (make-vector len)])
(let loop ([i 0])
(unless (fx= i len)
(#%vector-set! compact-vec i (#%vector-ref vec i))
(loop (fx+ i 1))))
compact-vec)]
[else vec])))
;; Remove empty weak boxes from a table. Count the number
;; of remaining entries, and remember to prune again when
@ -1184,9 +1149,10 @@
(loop (hash-iterate-next ht i)))]
[else new-ht]))))
(define (impersonate-hash-iterate-key+value who ht i key? value? pair?)
(let ([key (impersonate-hash-iterate-key who ht i)])
(define (impersonate-hash-iterate-key+value who ht i key? value? pair? bad-index-v)
(let ([key (impersonate-hash-iterate-key who ht i (if (eq? bad-index-v none) none none2))])
(cond
[(eq? key none2) (bad-index-result key? value? pair? bad-index-v)]
[(not value?) key]
[else
(let ([val (hash-ref ht key none)])
@ -1201,7 +1167,7 @@
[key? (values key val)]
[else val]))])))
(define (impersonate-hash-iterate-key who ht i)
(define (impersonate-hash-iterate-key who ht i bad-index-v)
;; We don't have to set up `get-k`, because `hash-iterate-key`
;; is prohibited from hashing any keys
(let loop ([ht ht])
@ -1224,5 +1190,11 @@
;; The same as `hash-iterate-key`, but with the correct `who`:
(do-hash-iterate-key+value who ht i
intmap-iterate-key
weak-hash-iterate-key
#t #f #f)])))
#t #f #f
bad-index-v)])))
(define (bad-index-result key? value? pair? bad-index-v)
(cond
[pair? (cons bad-index-v bad-index-v)]
[(and value? key?) (values bad-index-v bad-index-v)]
[else bad-index-v]))

12
racket/src/io/print/graph.rkt
View File

@ -43,9 +43,12 @@
(not (hash-weak? v))
(config-get config print-hash-table))
(and (not print-graph?)
(for/fold ([fuel (sub1 fuel)]) ([(k v) (in-hash v)]
;; Using `(in-hash-keys v #f)` and `(hash-ref v k #f)`
;; defends against misbehaving hash tables
(for/fold ([fuel (sub1 fuel)]) ([k (in-hash-keys v #f)]
#:break (not fuel))
(quick-no-graph? v (quick-no-graph? k fuel))))]
(define val (hash-ref v k #f))
(quick-no-graph? val (quick-no-graph? k fuel))))]
[(mpair? v)
(and (not print-graph?)
(not (eq? mode PRINT-MODE/UNQUOTED))
@ -149,9 +152,10 @@
(config-get config print-hash-table))
(checking! v)
(define unquoted?
(for/fold ([unquoted? #f]) ([(k v) (in-hash v)])
(for/fold ([unquoted? #f]) ([k (in-hash-keys v)])
(define val (hash-ref v k #f))
(define k-unquoted? (build-graph k mode))
(or (build-graph v mode)
(or (build-graph val mode)
k-unquoted?
unquoted?)))
(done! v unquoted?)]

194
racket/src/racket/src/list.c
View File

@ -696,22 +696,22 @@ scheme_init_list (Scheme_Startup_Env *env)
scheme_addto_prim_instance("hash-iterate-value",
scheme_make_noncm_prim(scheme_hash_table_iterate_value,
"hash-iterate-value",
2, 2),
2, 3),
env);
scheme_addto_prim_instance("hash-iterate-key",
scheme_make_noncm_prim(scheme_hash_table_iterate_key,
"hash-iterate-key",
2, 2),
2, 3),
env);
scheme_addto_prim_instance("hash-iterate-pair",
scheme_make_immed_prim(scheme_hash_table_iterate_pair,
"hash-iterate-pair",
2, 2),
2, 3),
env);
scheme_addto_prim_instance("hash-iterate-key+value",
scheme_make_prim_w_arity2(scheme_hash_table_iterate_key_value,
"hash-iterate-key+value",
2, 2, 2, 2),
"hash-iterate-key+value",
2, 3, 2, 2),
env);
scheme_addto_prim_instance("hash-keys-subset?",
@ -1000,21 +1000,21 @@ scheme_init_unsafe_hash (Scheme_Startup_Env *env)
/* unsafe-hash-iterate-key ---------------------------------------- */
p = scheme_make_noncm_prim(unsafe_hash_table_iterate_key,
"unsafe-mutable-hash-iterate-key", 2, 2);
"unsafe-mutable-hash-iterate-key", 2, 3);
SCHEME_PRIM_PROC_FLAGS(p) |=
scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE
| SCHEME_PRIM_IS_UNSAFE_OMITABLE);
scheme_addto_prim_instance ("unsafe-mutable-hash-iterate-key", p, env);
p = scheme_make_noncm_prim(unsafe_hash_tree_iterate_key,
"unsafe-immutable-hash-iterate-key", 2, 2);
"unsafe-immutable-hash-iterate-key", 2, 3);
SCHEME_PRIM_PROC_FLAGS(p) |=
scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_IS_UNSAFE_NONALLOCATE);
scheme_addto_prim_instance ("unsafe-immutable-hash-iterate-key", p, env);
p = scheme_make_noncm_prim(unsafe_bucket_table_iterate_key,
"unsafe-weak-hash-iterate-key", 2, 2);
"unsafe-weak-hash-iterate-key", 2, 3);
SCHEME_PRIM_PROC_FLAGS(p) |=
scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE
| SCHEME_PRIM_IS_UNSAFE_OMITABLE);
@ -1022,21 +1022,21 @@ scheme_init_unsafe_hash (Scheme_Startup_Env *env)
/* unsafe-hash-iterate-value ---------------------------------------- */
p = scheme_make_noncm_prim(unsafe_hash_table_iterate_value,
"unsafe-mutable-hash-iterate-value", 2, 2);
"unsafe-mutable-hash-iterate-value", 2, 3);
SCHEME_PRIM_PROC_FLAGS(p) |=
scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE
| SCHEME_PRIM_IS_UNSAFE_OMITABLE);
scheme_addto_prim_instance ("unsafe-mutable-hash-iterate-value", p, env);
p = scheme_make_noncm_prim(unsafe_hash_tree_iterate_value,
"unsafe-immutable-hash-iterate-value", 2, 2);
"unsafe-immutable-hash-iterate-value", 2, 3);
SCHEME_PRIM_PROC_FLAGS(p) |=
scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_IS_UNSAFE_NONALLOCATE);
scheme_addto_prim_instance ("unsafe-immutable-hash-iterate-value", p, env);
p = scheme_make_noncm_prim(unsafe_bucket_table_iterate_value,
"unsafe-weak-hash-iterate-value", 2, 2);
"unsafe-weak-hash-iterate-value", 2, 3);
SCHEME_PRIM_PROC_FLAGS(p) |=
scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE
| SCHEME_PRIM_IS_UNSAFE_OMITABLE);
@ -1045,7 +1045,7 @@ scheme_init_unsafe_hash (Scheme_Startup_Env *env)
/* unsafe-hash-iterate-key+value ---------------------------------------- */
p = scheme_make_prim_w_arity2(unsafe_hash_table_iterate_key_value,
"unsafe-mutable-hash-iterate-key+value",
2, 2, 2, 2);
2, 3, 2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |=
scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE
| SCHEME_PRIM_IS_UNSAFE_OMITABLE);
@ -1053,7 +1053,7 @@ scheme_init_unsafe_hash (Scheme_Startup_Env *env)
p = scheme_make_prim_w_arity2(unsafe_hash_tree_iterate_key_value,
"unsafe-immutable-hash-iterate-key+value",
2, 2, 2, 2);
2, 3, 2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |=
scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_IS_UNSAFE_NONALLOCATE);
@ -1061,7 +1061,7 @@ scheme_init_unsafe_hash (Scheme_Startup_Env *env)
p = scheme_make_prim_w_arity2(unsafe_bucket_table_iterate_key_value,
"unsafe-weak-hash-iterate-key+value",
2, 2, 2, 2);
2, 3, 2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |=
scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE
| SCHEME_PRIM_IS_UNSAFE_OMITABLE);
@ -1070,7 +1070,7 @@ scheme_init_unsafe_hash (Scheme_Startup_Env *env)
/* unsafe-hash-iterate-pair ---------------------------------------- */
p = scheme_make_immed_prim(unsafe_hash_table_iterate_pair,
"unsafe-mutable-hash-iterate-pair",
2, 2);
2, 3);
SCHEME_PRIM_PROC_FLAGS(p) |=
scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION
| SCHEME_PRIM_IS_UNSAFE_OMITABLE);
@ -1078,14 +1078,14 @@ scheme_init_unsafe_hash (Scheme_Startup_Env *env)
p = scheme_make_immed_prim(unsafe_hash_tree_iterate_pair,
"unsafe-immutable-hash-iterate-pair",
2, 2);
2, 3);
SCHEME_PRIM_PROC_FLAGS(p) |=
scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
scheme_addto_prim_instance ("unsafe-immutable-hash-iterate-pair", p, env);
p = scheme_make_immed_prim(unsafe_bucket_table_iterate_pair,
"unsafe-weak-hash-iterate-pair",
2, 2);
2, 3);
SCHEME_PRIM_PROC_FLAGS(p) |=
scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_OMITABLE_ALLOCATION
| SCHEME_PRIM_IS_UNSAFE_OMITABLE);
@ -3047,13 +3047,18 @@ Scheme_Object *scheme_hash_table_iterate_next(int argc, Scheme_Object *argv[])
scheme_wrong_contract("hash-iterate-next",
"exact-nonnegative-integer?", 1, argc, argv);
scheme_contract_error("hash-iterate-next", "no element at index",
"index", 1, argv[1],
NULL);
return NULL;
if (0) {
scheme_contract_error("hash-iterate-next", "no element at index",
"index", 1, argv[1],
NULL);
return NULL;
} else
return scheme_false;
}
static int hash_table_index(const char *name, int argc, Scheme_Object *argv[], Scheme_Object **_k, Scheme_Object **_v)
static int hash_table_index(const char *name, int argc, Scheme_Object *argv[],
Scheme_Object **_k, Scheme_Object **_v,
Scheme_Object *bad_index_v)
{
Scheme_Object *p = argv[1], *obj = argv[0];
mzlonglong pos;
@ -3082,10 +3087,16 @@ static int hash_table_index(const char *name, int argc, Scheme_Object *argv[], S
&& (SCHEME_INT_VAL(p) >= 0))
|| (SCHEME_BIGNUMP(p)
&& SCHEME_BIGPOS(p))) {
scheme_contract_error(name, "no element at index",
"index", 1, p,
NULL);
return 0;
if (bad_index_v) {
if (_k) *_k = bad_index_v;
if (_v) *_v = bad_index_v;
return 0;
} else {
scheme_contract_error(name, "no element at index",
"index", 1, p,
NULL);
return 0;
}
}
scheme_wrong_contract(name, "exact-nonnegative-integer?", 1, argc, argv);
@ -3096,21 +3107,19 @@ 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)) {
if (hash_table_index(name, argc, argv, &key, NULL, ((argc > 2) ? argv[2] : NULL))) {
Scheme_Object *obj = argv[0];
if (SCHEME_NP_CHAPERONEP(obj))
return chaperone_hash_key(name, obj, key);
else
return key;
}
return NULL;
return key;
}
Scheme_Object *scheme_hash_table_iterate_value(int argc, Scheme_Object *argv[])
{
const char *name = "hash-iterate-value";
Scheme_Object *key, *val;
if (hash_table_index(name, argc, argv, &key, &val)) {
if (hash_table_index(name, argc, argv, &key, &val, ((argc > 2) ? argv[2] : NULL))) {
Scheme_Object *obj = argv[0];
if (SCHEME_NP_CHAPERONEP(obj)) {
Scheme_Object *chap_key, *chap_val;
@ -3118,17 +3127,15 @@ Scheme_Object *scheme_hash_table_iterate_value(int argc, Scheme_Object *argv[])
chaperone_hash_key_value(name, obj, key, &chap_key, &chap_val, ischap);
return chap_val;
}
else
return val;
}
return NULL;
return val;
}
Scheme_Object *scheme_hash_table_iterate_pair(int argc, Scheme_Object *argv[])
{
const char *name = "hash-iterate-pair";
Scheme_Object *key, *val;
if (hash_table_index(name, argc, argv, &key, &val)) {
if (hash_table_index(name, argc, argv, &key, &val, ((argc > 2) ? argv[2] : NULL))) {
Scheme_Object *obj = argv[0];
if (SCHEME_NP_CHAPERONEP(obj)) {
Scheme_Object *chap_key, *chap_val;
@ -3136,29 +3143,24 @@ Scheme_Object *scheme_hash_table_iterate_pair(int argc, Scheme_Object *argv[])
chaperone_hash_key_value(name, obj, key, &chap_key, &chap_val, ischap);
return scheme_make_pair(chap_key, chap_val);
}
else
return scheme_make_pair(key, val);
}
return NULL;
return scheme_make_pair(key, val);
}
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];
Scheme_Object *key, *val, *res[2];
if (hash_table_index(name, argc, argv, &key, &val, ((argc > 2) ? argv[2] : NULL))) {
Scheme_Object *obj = argv[0];
if (SCHEME_NP_CHAPERONEP(obj)) {
int ischap = SCHEME_HASHTRP(SCHEME_CHAPERONE_VAL(obj));
chaperone_hash_key_value(name, obj, key, &res[0], &res[1], ischap);
chaperone_hash_key_value(name, obj, key, &key, &val, ischap);
}
else {
res[0] = key;
res[1] = val;
}
return scheme_values(2, res);
}
return NULL;
res[0] = key;
res[1] = val;
return scheme_values(2, res);
}
static Scheme_Object *hash_keys_subset_p_slow(int argc, Scheme_Object *argv[])
@ -4242,12 +4244,14 @@ Scheme_Object *unsafe_hash_table_iterate_next(int argc, Scheme_Object *argv[])
if (res)
return res;
else
else if (0) {
scheme_contract_error("unsafe-mutable-hash-iterate-next",
"no element at index",
"index", 1, argv[1],
NULL);
return NULL;
return NULL;
} else
return scheme_false;
}
Scheme_Object *unsafe_hash_table_iterate_key(int argc, Scheme_Object *argv[])
@ -4265,8 +4269,13 @@ Scheme_Object *unsafe_hash_table_iterate_key(int argc, Scheme_Object *argv[])
if (scheme_hash_table_index((Scheme_Hash_Table *)obj, pos, &key, NULL))
return key;
}
scheme_contract_error(name, "no element at index", "index", 1, argv[1], NULL);
return NULL;
if (argc > 2)
return argv[2];
else {
scheme_contract_error(name, "no element at index", "index", 1, argv[1], NULL);
return NULL;
}
}
static Scheme_Object *unsafe_hash_table_iterate_value_slow(int argc, Scheme_Object *argv[])
@ -4283,11 +4292,16 @@ static Scheme_Object *unsafe_hash_table_iterate_value_slow(int argc, Scheme_Obje
return chap_val;
}
} else {
if(scheme_hash_table_index((Scheme_Hash_Table *)obj, pos, &key, &val))
if (scheme_hash_table_index((Scheme_Hash_Table *)obj, pos, &key, &val))
return val;
}
scheme_contract_error(name, "no element at index", "index", 1, argv[1], NULL);
return NULL;
if (argc > 2)
return argv[2];
else {
scheme_contract_error(name, "no element at index", "index", 1, argv[1], NULL);
return NULL;
}
}
Scheme_Object *unsafe_hash_table_iterate_value(int argc, Scheme_Object *argv[])
@ -4320,8 +4334,13 @@ Scheme_Object *unsafe_hash_table_iterate_pair(int argc, Scheme_Object *argv[])
if (scheme_hash_table_index((Scheme_Hash_Table *)obj, pos, &key, &val))
return scheme_make_pair(key, val);
}
scheme_contract_error(name, "no element at index", "index", 1, argv[1], NULL);
return NULL;
if (argc > 2)
return scheme_make_pair(argv[2], argv[2]);
else {
scheme_contract_error(name, "no element at index", "index", 1, argv[1], NULL);
return NULL;
}
}
Scheme_Object *unsafe_hash_table_iterate_key_value(int argc, Scheme_Object *argv[])
@ -4341,8 +4360,15 @@ Scheme_Object *unsafe_hash_table_iterate_key_value(int argc, Scheme_Object *argv
if (scheme_hash_table_index((Scheme_Hash_Table *)obj, pos, &res[0], &res[1]))
return scheme_values(2, res);
}
scheme_contract_error(name, "no element at index", "index", 1, argv[1], NULL);
return NULL;
if (argc > 2) {
res[0] = argv[2];
res[1] = argv[2];
return scheme_values(2, res);
} else {
scheme_contract_error(name, "no element at index", "index", 1, argv[1], NULL);
return NULL;
}
}
/* unsafe_hash_tree, ie SCHEME_HASHTRP, ops */
@ -4469,12 +4495,14 @@ Scheme_Object *unsafe_bucket_table_iterate_next(int argc, Scheme_Object *argv[])
SCHEME_INT_VAL(argv[1]));
if (res)
return res;
else
else if (0) {
scheme_contract_error("unsafe-weak-hash-iterate-next",
"no element at index",
"index", 1, argv[1],
NULL);
return NULL;
return NULL;
} else
return scheme_false;
}
Scheme_Object *unsafe_bucket_table_iterate_key(int argc, Scheme_Object *argv[])
@ -4488,11 +4516,16 @@ Scheme_Object *unsafe_bucket_table_iterate_key(int argc, Scheme_Object *argv[])
if (scheme_bucket_table_index(ht, pos, &key, NULL))
return chaperone_hash_key(name, obj, key);
} else {
if(scheme_bucket_table_index((Scheme_Bucket_Table *)obj, pos, &key, NULL))
if (scheme_bucket_table_index((Scheme_Bucket_Table *)obj, pos, &key, NULL))
return key;
}
scheme_contract_error(name, "no element at index", "index", 1, argv[1], NULL);
return NULL;
if (argc > 2)
return argv[2];
else {
scheme_contract_error(name, "no element at index", "index", 1, argv[1], NULL);
return NULL;
}
}
Scheme_Object *unsafe_bucket_table_iterate_value(int argc, Scheme_Object *argv[])
@ -4509,11 +4542,16 @@ Scheme_Object *unsafe_bucket_table_iterate_value(int argc, Scheme_Object *argv[]
return chap_val;
}
} else {
if(scheme_bucket_table_index((Scheme_Bucket_Table *)obj, pos, &key, &val))
if (scheme_bucket_table_index((Scheme_Bucket_Table *)obj, pos, &key, &val))
return val;
}
scheme_contract_error(name, "no element at index", "index", 1, argv[1], NULL);
return NULL;
if (argc > 2)
return argv[2];
else {
scheme_contract_error(name, "no element at index", "index", 1, argv[1], NULL);
return NULL;
}
}
Scheme_Object *unsafe_bucket_table_iterate_pair(int argc, Scheme_Object *argv[])
@ -4533,8 +4571,13 @@ Scheme_Object *unsafe_bucket_table_iterate_pair(int argc, Scheme_Object *argv[])
if(scheme_bucket_table_index((Scheme_Bucket_Table *)obj, pos, &key, &val))
return scheme_make_pair(key, val);
}
scheme_contract_error(name, "no element at index", "index", 1, argv[1], NULL);
return NULL;
if (argc > 2)
return scheme_make_pair(argv[2], argv[2]);
else {
scheme_contract_error(name, "no element at index", "index", 1, argv[1], NULL);
return NULL;
}
}
Scheme_Object *unsafe_bucket_table_iterate_key_value(int argc, Scheme_Object *argv[])
@ -4552,9 +4595,16 @@ Scheme_Object *unsafe_bucket_table_iterate_key_value(int argc, Scheme_Object *ar
}
} else {
Scheme_Bucket_Table *ht = (Scheme_Bucket_Table *)obj;
if(scheme_bucket_table_index(ht, pos, &res[0], &res[1]))
if (scheme_bucket_table_index(ht, pos, &res[0], &res[1]))
return scheme_values(2, res);
}
scheme_contract_error(name, "no element at index", "index", 1, argv[1], NULL);
return NULL;
if (argc > 2) {
res[0] = argv[2];
res[1] = argv[2];
return scheme_values(2, res);
} else {
scheme_contract_error(name, "no element at index", "index", 1, argv[1], NULL);
return NULL;
}
}

4
racket/src/racket/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "7.0.0.9"
#define MZSCHEME_VERSION "7.0.0.10"
#define MZSCHEME_VERSION_X 7
#define MZSCHEME_VERSION_Y 0
#define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 9
#define MZSCHEME_VERSION_W 10
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)