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

Documentation and adjustments to `clear'-related hash and set operations

Browse Source 
Document and adjust `hash-clear!', `hash-clear', and `hash-empty?'.

Also, add `hash-copy-clear'.

The clear operations are constant-time for a non-impersonated
hash table, otherwise they always remove keys one-by-one to
trigger the impersonator's interpositions.

The `hash-clear' operation works only on immutable hash tables,
in contrast to the original implementation. The new `hash-copy-clear'
works on both immutable and mutable hash tables. The "copy"
in its name is meant to suggest a difference with `hash-clear',
even on immutable hash tables: any chaperone on the input
is not on the outpue.

Change `set-clear' to be like `hash-clear', and add
`set-copy-clear'.

(Changes are in consultation with Carl.)
This commit is contained in:
Matthew Flatt 2013-08-15 07:39:15 -06:00
parent 5aeca646d4
commit 6baf90e3be
23 changed files with 1143 additions and 975 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -60,7 +60,7 @@ a table-specific semaphore as needed. Three caveats apply, however:
uses @racket[equal?] or @racket[eqv?] key comparisons, all current
and future operations on the hash table may block indefinitely.}
@item{The @racket[hash-map] and @racket[hash-for-each] procedures do
@item{The @racket[hash-map], @racket[hash-for-each], and @racket[hash-clear!] procedures do
not use the table's semaphore to guard the traversal as a whole.
Changes by one thread to a hash table can affect the keys and values
seen by another thread part-way through its traversal of the same
@ -313,6 +313,36 @@ Functionally removes any existing mapping for @racket[key] in
@see-also-mutable-key-caveat[]}
@defproc[(hash-clear! [hash (and/c hash? (not/c immutable?))])
void?]{
Removes all mappings from @racket[hash].
If @racket[hash] is not an @tech{impersonator}, then all mappings are
removed in constant time. If @racket[hash] is an @tech{impersonator},
then each key is removed one-by-one using @racket[hash-remove!].
@see-also-caveats[]}
@defproc[(hash-clear [hash (and/c hash? immutable?)])
(and/c hash? immutable?)]{
Functionally removes all mappings from @racket[hash].
If @racket[hash] is not an @tech{impersonator}, then clearing is
equivalent to creating a new @tech{hash table}, and the operation is
performed in constant time. If @racket[hash] is an @tech{chaperone},
then each key is removed one-by-one using @racket[hash-remove].}
@defproc[(hash-copy-clear [hash hash?]) hash?]{
Produces an empty @tech{hash table} with the same key-comparison
procedure and mutability of @racket[hash].}
@defproc[(hash-map [hash hash?]
[proc (any/c any/c . -> . any/c)])
(listof any/c)]{
@ -375,6 +405,11 @@ constant time and atomically. If @racket[hash] retains it keys weakly, a
traversal is required to count the keys.}
@defproc[(hash-empty? [hash hash?]) boolean?]{
Equivalent to @racket[(zero? (hash-count hash))].}
@defproc[(hash-iterate-first [hash hash?])
(or/c #f exact-nonnegative-integer?)]{

63
pkgs/racket-pkgs/racket-doc/scribblings/reference/sets.scrbl
View File

@ -48,6 +48,19 @@ update, just like mutable hash sets; the constant on immutable operations is
usually larger, but the functional nature of immutable hash sets can pay off in
certain algorithms.
All hash sets @impl{implement} @racket[set->stream],
@racket[set-empty?], @racket[set-member?], @racket[set-count],
@racket[subset?], @racket[proper-subset?], @racket[set-map],
@racket[set-for-each], @racket[set-copy], @racket[set-copy-clear],
@racket[set->list], and @racket[set-first]. Immutable hash sets in
addition @impl{implement} @racket[set-add], @racket[set-remove],
@racket[set-clear], @racket[set-union], @racket[set-intersect],
@racket[set-subtract], and @racket[set-symmetric-difference]. Mutable
hash sets in addition @impl{implement} @racket[set-add!],
@racket[set-remove!], @racket[set-clear!], @racket[set-union!],
@racket[set-intersect!], @racket[set-subtract!], and
@racket[set-symmetric-difference!].
Operations on sets that contain elements that are mutated are
unpredictable in much the same way that @tech{hash table} operations are
unpredictable when keys are mutated.
@ -311,7 +324,6 @@ time for @tech{hash sets}. Has no fallback.
}
@defproc[(set-empty? [st set?]) boolean?]{
Returns @racket[#t] if @racket[st] has no members; returns @racket[#f]
@ -368,15 +380,30 @@ Supported for any @racket[st] that @impl{implements}:
Produces a new, mutable set of the same type and with the same elements as
@racket[st].
Supported for any @racket[st] that @impl{implements} @racket[set-clear] and
@racket[set-add!], and @supp{supports} @racket[set->stream].
Supported for any @racket[st] that @supp{supports} @racket[set->stream] and
either @impl{implements} @racket[set-copy-clear] and @racket[set-add!].
}
@defproc[(set-copy-clear [st set?]) (and/c set? set-empty?)]{
Produces a new, empty set of the same type, mutability, and key strength as
@racket[st].
A difference between @racket[set-copy-clear] and @racket[set-clear] is
that the latter conceptually iterates @racket[set-remove] on the given
set, and so it preserves any contract on the given set. The
@racket[set-copy-clear] function produces a new set without any
contracts.
Supported for any @racket[st] that @impl{implements} @racket[set-remove] and @supp{supports}
@racket[set->stream].
}
@defproc[(set-clear [st set?]) (and/c set? set-empty?)]{
Produces a new, empty set of the same type, mutability, and key strength as
@racket[st].
Produces set by removing all elements of @racket[st].
Supported for any @racket[st] that @impl{implements} @racket[set-remove] and @supp{supports}
@racket[set->stream].
@ -387,7 +414,7 @@ Supported for any @racket[st] that @impl{implements} @racket[set-remove] and @su
Removes all elements from @racket[st].
Supported for any @racket[st] that @impl{implements} @racket[set-remove] and either
Supported for any @racket[st] that @impl{implements} @racket[set-remove!] and either
@supp{supports} @racket[set->stream] or @impl{implements} @racket[set-first] and either @racket[set-count] or @racket[set-empty?].
}
@ -467,7 +494,7 @@ If @racket[st0] is a @tech{hash set}, each @racket[st] must also be a
sets may differ. This operation runs on hash sets in time proportional to the
size of @racket[st0].
Supported for any @racket[st] that @impl{implements} @racket[set-remove!] and @tech{supports} @racket[set->stream].
Supported for any @racket[st] that @impl{implements} @racket[set-remove!] and @supp{supports} @racket[set->stream].
}
@ -487,7 +514,7 @@ sets may differ. This operation runs on hash sets in time proportional to the
size of @racket[st0].
Supported for any @racket[st] that @impl{implements} either @racket[set-remove] or
both @racket[set-clear] and @racket[set-add], and @tech{supports} @racket[set->stream].
both @racket[set-clear] and @racket[set-add], and @supp{supports} @racket[set->stream].
}
@ -502,7 +529,7 @@ If @racket[st0] is a @tech{hash set}, each @racket[st] must also be a
sets may differ. This operation runs on hash sets in time proportional to the
size of @racket[st0].
Supported for any @racket[st] that @impl{implements} @racket[set-remove!] and @tech{supports} @racket[set->stream].
Supported for any @racket[st] that @impl{implements} @racket[set-remove!] and @supp{supports} @racket[set->stream].
}
@ -522,7 +549,7 @@ If @racket[st0] is a @tech{hash set}, each @racket[st] must also be a
sets may differ. This operation runs on hash sets in time proportional to the
total size of all of the sets except the largest immutable set.
Supported for any @racket[st] that @impl{implements} @racket[set-remove] or both @racket[set-clear] and @racket[set-add], and @tech{supports} @racket[set->stream].
Supported for any @racket[st] that @impl{implements} @racket[set-remove] or both @racket[set-clear] and @racket[set-add], and @supp{supports} @racket[set->stream].
@examples[#:eval set-eval
(set-symmetric-difference (set 1) (set 1 2) (set 1 2 3))
@ -542,7 +569,7 @@ If @racket[st0] is a @tech{hash set}, each @racket[st] must also be a
sets may differ. This operation runs on hash sets in time proportional to the
total size of the @racket[st]s.
Supported for any @racket[st] that @impl{implements} @racket[set-remove!] and @tech{supports} @racket[set->stream].
Supported for any @racket[st] that @impl{implements} @racket[set-remove!] and @supp{supports} @racket[set->stream].
}
@ -561,7 +588,7 @@ If @racket[st0] is a @tech{hash set}, each @racket[st] must also be a
sets may differ. This operation runs on hash sets in time proportional to the
size of @racket[st] plus the size of @racket[st2].
Supported for any @racket[st] and @racket[st2] that both @tech{support}
Supported for any @racket[st] and @racket[st2] that both @supp{support}
@racket[subset?]; also supported for any if @racket[st2] that @impl{implements}
@racket[set=?] regardless of @racket[st].
@ -592,7 +619,7 @@ If @racket[st0] is a @tech{hash set}, each @racket[st] must also be a
sets may differ. This operation runs on hash sets in time proportional to the
size of @racket[st].
Supported for any @racket[st] that @tech{supports} @racket[set->stream].
Supported for any @racket[st] that @supp{supports} @racket[set->stream].
@examples[#:eval set-eval
(subset? (set 1) (set 1 2 3))
@ -617,7 +644,7 @@ If @racket[st0] is a @tech{hash set}, each @racket[st] must also be a
sets may differ. This operation runs on hash sets in time proportional to the
size of @racket[st] plus the size of @racket[st2].
Supported for any @racket[st] and @racket[st2] that both @tech{support}
Supported for any @racket[st] and @racket[st2] that both @supp{support}
@racket[subset?].
@examples[#:eval set-eval
@ -632,7 +659,7 @@ Supported for any @racket[st] and @racket[st2] that both @tech{support}
Produces a list containing the elements of @racket[st].
Supported for any @racket[st] that @tech{supports} @racket[set->stream].
Supported for any @racket[st] that @supp{supports} @racket[set->stream].
}
@ -644,7 +671,7 @@ Applies the procedure @racket[proc] to each element in
@racket[st] in an unspecified order, accumulating the results
into a list.
Supported for any @racket[st] that @tech{supports} @racket[set->stream].
Supported for any @racket[st] that @supp{supports} @racket[set->stream].
}
@ -656,7 +683,7 @@ Supported for any @racket[st] that @tech{supports} @racket[set->stream].
Applies @racket[proc] to each element in @racket[st] (for the
side-effects of @racket[proc]) in an unspecified order.
Supported for any @racket[st] that @tech{supports} @racket[set->stream].
Supported for any @racket[st] that @supp{supports} @racket[set->stream].
}
@ -665,7 +692,7 @@ Supported for any @racket[st] that @tech{supports} @racket[set->stream].
Explicitly converts a set to a sequence for use with @racket[for] and
other forms.
Supported for any @racket[st] that @tech{supports} @racket[set->stream].
Supported for any @racket[st] that @supp{supports} @racket[set->stream].
}

25
pkgs/racket-pkgs/racket-test/tests/racket/basic.rktl
View File

@ -2080,7 +2080,9 @@
hash-map hash-for-each
hash-iterate-first hash-iterate-next
hash-iterate-value hash-iterate-key
hash-copy)
hash-copy
hash-clear! hash-clear
hash-empty?)
(define-struct ax (b c)) ; opaque
(define-struct a (b c) #:inspector (make-inspector))
@ -2269,6 +2271,18 @@
(test 'the-val3 hash-ref c2 'the-key3)
(test 'the-val4 hash-ref c1 'the-key4)))
(for ([make-hash (list make-hash
make-weak-hash)])
(when make-hash
(define c1 (make-hash))
(hash-set! c1 'the-key1 'the-val1)
(hash-set! c1 'the-key2 'the-val2)
(hash-set! c1 'the-key3 'the-val3)
(hash-set! c1 'the-key4 'the-val4)
(test #f hash-empty? c1)
(hash-clear! c1)
(test #t hash-empty? c1)))
(save)) ; prevents gcing of the ht-registered values
(hash-tests make-hash make-hasheq make-hasheqv
@ -2278,7 +2292,9 @@
hash-map hash-for-each
hash-iterate-first hash-iterate-next
hash-iterate-value hash-iterate-key
hash-copy)
hash-copy
hash-clear! hash-clear
hash-empty?)
(let ([ub-wrap (lambda (proc)
(lambda (ht . args)
(apply proc (unbox ht) args)))])
@ -2301,7 +2317,10 @@
(ub-wrap hash-iterate-next)
(ub-wrap hash-iterate-value)
(ub-wrap hash-iterate-key)
(lambda (ht) (box (unbox ht)))))
(lambda (ht) (box (unbox ht)))
(lambda (ht) (set-box! ht (hash-clear (unbox ht))))
#f
(ub-wrap hash-empty?)))
(test #f hash? 5)
(test #t hash? (make-hasheq))

3
pkgs/racket-pkgs/racket-test/tests/racket/chaperone.rktl
View File

@ -866,7 +866,8 @@
(test #f hash-ref h 1 #f)
(err/rt-test (hash-iterate-value h (hash-iterate-first h)))
(err/rt-test (hash-map h void))
(err/rt-test (hash-for-each h void))))])
(err/rt-test (hash-for-each h void))
(err/rt-test (hash-clear! h))))])
(check (make-hash))
(check (make-hasheq))
(check (make-weak-hash))

5
pkgs/racket-pkgs/racket-test/tests/racket/set.rktl
View File

@ -297,7 +297,10 @@
(for ([elem (in-list elems)])
(test #true set-member? ms elem)
(test #true set-member? s elem))
(test #true set-member? s elem)
(test #false set-member? (set-clear s) elem)
(test #false set-member? (set-copy-clear ms) elem)
(test #false set-member? (set-copy-clear s) elem))
(for ([elem (in-list just-supers)])
(test #false set-member? ms elem)

2
racket/collects/racket/HISTORY.txt
View File

@ -1,5 +1,6 @@
Version 5.90.0.6
Added path<?, symbol<?
Added hash-copy-clear
Version 5.90.0.4
Add current-library-collection-links, find-library-collection-links
@ -22,6 +23,7 @@ Version 5.90.0.2
Added #%declare
Cross-phase persistent modules must be declared with
(#%declare #:cross-phase-persistent)
Added hash-clear, hash-clear!, and hash-empty?
Version 5.90.0.1
Added "share" directory, moved "pkgs" there; moved "collects"

58
racket/collects/racket/private/hash.rkt
View File

@ -47,39 +47,39 @@
(lambda (x k v)
(hash-set! table k v))))
;; This could probably be implemented in O(1) internally by simply
;; throwing away the hash table's array and allocating a new one.
;; At the Racket level, we'll have to make do with O(n) iteration.
(define (hash-clear! table)
(unless (and (hash? table) (not (immutable? table)))
(raise-argument-error 'hash-clear!
"(and/c hash? (not/c immutable?))"
table))
(let loop ()
(define i (hash-iterate-first table))
(when i
(hash-remove! table (hash-iterate-key table i))
(loop))))
(define (hash-clear table)
(define (hash-copy-clear table)
(unless (hash? table)
(raise-argument-error 'hash-clear "hash?" table))
(cond
[(immutable? table)
(cond
[(immutable? table)
(cond
[(hash-equal? table) (hash)]
[(hash-eqv? table) (hasheqv)]
[(hash-eq? table) (hasheq)])]
[(hash-weak? table)
(cond
[(hash-equal? table) (make-weak-hash)]
[(hash-eqv? table) (make-weak-hasheqv)]
[(hash-eq? table) (make-weak-hasheq)])]
[else
(cond
[(hash-equal? table) (make-hash)]
[(hash-eqv? table) (make-hasheqv)]
[(hash-eq? table) (make-hasheq)])]))
(define (hash-clear table)
(unless (and (hash? table) (immutable? table))
(raise-argument-error 'hash-clear "(and/c hash? immutable?)" table))
(if (not (impersonator? table))
;; Can just make a new one:
(cond
[(hash-equal? table) (hash)]
[(hash-eqv? table) (hasheqv)]
[(hash-eq? table) (hasheq)])]
[(hash-weak? table)
(cond
[(hash-equal? table) (make-weak-hash)]
[(hash-eqv? table) (make-weak-hasheqv)]
[(hash-eq? table) (make-weak-hasheq)])]
[else
(cond
[(hash-equal? table) (make-hash)]
[(hash-eqv? table) (make-hasheqv)]
[(hash-eq? table) (make-hasheq)])]))
[(hash-eq? table) (hasheq)])
;; To preserve chaperones, need to remove
;; each individual key:
(for/fold ([table table]) ([k (in-hash-keys table)])
(hash-remove table k))))
(define (hash-empty? table)
(unless (hash? table)
@ -94,4 +94,4 @@
hash-set*!
hash-empty?
hash-clear
hash-clear!))
hash-copy-clear))

7
racket/collects/racket/private/set-types.rkt
View File

@ -130,6 +130,10 @@
s
(hash-remove (custom-set-table s) (set-wrap-elem s x))))
(define (custom-set-copy-clear s)
(dprintf "custom-set-copy-clear\n")
(update-custom-set-table s (hash-copy-clear (custom-set-table s))))
(define (custom-set-clear s)
(dprintf "custom-set-clear\n")
(update-custom-set-table s (hash-clear (custom-set-table s))))
@ -469,6 +473,7 @@
(define set-map custom-set-map)
(define set-for-each custom-set-for-each)
(define set-copy custom-set-copy)
(define set-copy-clear custom-set-copy-clear)
(define set->list custom-set->list)
(define set->stream custom-set->stream)
(define in-set custom-in-set)
@ -493,11 +498,11 @@
(define set-map custom-set-map)
(define set-for-each custom-set-for-each)
(define set-copy custom-set-copy)
(define set-copy-clear custom-set-copy-clear)
(define set->list custom-set->list)
(define set->stream custom-set->stream)
(define in-set custom-in-set)
(define set-first custom-set-first)
(define set-clear custom-set-clear)
(define set-add! custom-set-add!)
(define set-remove! custom-set-remove!)
(define set-clear! custom-set-clear!)

7
racket/collects/racket/private/set.rkt
View File

@ -9,7 +9,8 @@
set-empty? set-member? set-count
set=? subset? proper-subset?
set-map set-for-each
set-copy set->list set->stream set-first set-rest
set-copy set-copy-clear
set->list set->stream set-first set-rest
set-add set-remove set-clear
set-union set-intersect set-subtract set-symmetric-difference
set-add! set-remove! set-clear!
@ -224,7 +225,7 @@
(define (fallback-copy s)
(cond
[(set-implements? s 'set-clear 'set-add!)
[(set-implements? s 'set-copy-clear 'set-add!)
(define s2 (set-clear s))
(for ([x (*in-set s)])
(set-add! s2 x))
@ -418,6 +419,7 @@
(set-map set f)
(set-for-each set f)
(set-copy set)
(set-copy-clear set)
(in-set set)
(set->list set)
(set->stream set)
@ -448,6 +450,7 @@
(define proper-subset? list-proper-subset?)
(define set-map list-map)
(define set-for-each list-for-each)
(define set-copy-clear list-clear)
(define in-set in-list)
(define set->list values)
(define set->stream values)

3
racket/collects/racket/set.rkt
View File

@ -144,7 +144,7 @@
[proper-subset? (or/c (-> set? ctc boolean?) #f)]
[set-map (or/c (-> set? (-> elem/c any/c) list?) #f)]
[set-for-each (or/c (-> set? (-> elem/c any) void?) #f)]
[set-copy (or/c (-> set? ctc) #f)]
[set-copy (or/c (-> set? set?) #f)]
[in-set (or/c (-> set? sequence?) #f)]
[set->list (or/c (-> set? (listof elem/c)) #f)]
[set->stream (or/c (-> set? stream?) #f)]
@ -153,6 +153,7 @@
[set-add (or/c (-> set? elem/c ctc) #f)]
[set-remove (or/c (-> set? elem/c ctc) #f)]
[set-clear (or/c (-> set? ctc) #f)]
[set-copy-clear (or/c (-> set? set?) #f)]
[set-union
(or/c (->* [set?] [] #:rest (listof ctc) ctc) #f)]
[set-intersect

2
racket/src/racket/include/mzwin.def
View File

@ -234,6 +234,7 @@ EXPORTS
scheme_bucket_from_table
scheme_bucket_table_equal
scheme_clone_bucket_table
scheme_clear_bucket_table
scheme_make_hash_table
scheme_make_hash_table_equal
scheme_make_hash_table_eqv
@ -246,6 +247,7 @@ EXPORTS
scheme_is_hash_table_equal
scheme_is_hash_table_eqv
scheme_clone_hash_table
scheme_clear_hash_table
scheme_make_hash_tree
scheme_hash_tree_set
scheme_hash_tree_get

2
racket/src/racket/include/mzwin3m.def
View File

@ -249,6 +249,7 @@ EXPORTS
scheme_bucket_from_table
scheme_bucket_table_equal
scheme_clone_bucket_table
scheme_clear_bucket_table
scheme_make_hash_table
scheme_make_hash_table_equal
scheme_make_hash_table_eqv
@ -261,6 +262,7 @@ EXPORTS
scheme_is_hash_table_equal
scheme_is_hash_table_eqv
scheme_clone_hash_table
scheme_clear_hash_table
scheme_make_hash_tree
scheme_hash_tree_set
scheme_hash_tree_get

2
racket/src/racket/include/racket.exp
View File

@ -251,6 +251,7 @@ scheme_lookup_in_table
scheme_bucket_from_table
scheme_bucket_table_equal
scheme_clone_bucket_table
scheme_clear_bucket_table
scheme_make_hash_table
scheme_make_hash_table_equal
scheme_make_hash_table_eqv
@ -263,6 +264,7 @@ scheme_hash_table_equal
scheme_is_hash_table_equal
scheme_is_hash_table_eqv
scheme_clone_hash_table
scheme_clear_hash_table
scheme_make_hash_tree
scheme_hash_tree_set
scheme_hash_tree_get

2
racket/src/racket/include/racket3m.exp
View File

@ -257,6 +257,7 @@ scheme_lookup_in_table
scheme_bucket_from_table
scheme_bucket_table_equal
scheme_clone_bucket_table
scheme_clear_bucket_table
scheme_make_hash_table
scheme_make_hash_table_equal
scheme_make_hash_table_eqv
@ -269,6 +270,7 @@ scheme_hash_table_equal
scheme_is_hash_table_equal
scheme_is_hash_table_eqv
scheme_clone_hash_table
scheme_clear_hash_table
scheme_make_hash_tree
scheme_hash_tree_set
scheme_hash_tree_get

1826
racket/src/racket/src/cstartup.inc
View File

File diff suppressed because it is too large Load Diff

19
racket/src/racket/src/hash.c
View File

@ -197,6 +197,15 @@ Scheme_Hash_Table *scheme_make_hash_table(int type)
return table;
}
void scheme_clear_hash_table(Scheme_Hash_Table *ht)
{
ht->size = 0;
ht->count = 0;
ht->keys = NULL;
ht->vals = NULL;
ht->mcount = 0;
}
static Scheme_Object *do_hash(Scheme_Hash_Table *table, Scheme_Object *key, int set, Scheme_Object *val)
{
Scheme_Object *tkey, **keys;
@ -578,6 +587,16 @@ scheme_make_bucket_table (intptr_t size, int type)
return table;
}
void scheme_clear_bucket_table(Scheme_Bucket_Table *bt)
{
Scheme_Bucket **ba;
bt->count = 0;
bt->size = 4;
ba = (Scheme_Bucket **)scheme_malloc(bt->size * sizeof(Scheme_Bucket **));
bt->buckets = ba;
}
static Scheme_Bucket *
allocate_bucket (Scheme_Bucket_Table *table, const char *key, void *val)
{

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

@ -122,6 +122,7 @@ Scheme_Object *scheme_hash_table_put(int argc, Scheme_Object *argv[]);
static Scheme_Object *hash_table_get(int argc, Scheme_Object *argv[]);
static Scheme_Object *hash_table_remove_bang(int argc, Scheme_Object *argv[]);
static Scheme_Object *hash_table_remove(int argc, Scheme_Object *argv[]);
static Scheme_Object *hash_table_clear_bang(int argc, Scheme_Object *argv[]);
static Scheme_Object *hash_table_map(int argc, Scheme_Object *argv[]);
static Scheme_Object *hash_table_for_each(int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_hash_table_iterate_start(int argc, Scheme_Object *argv[]);
@ -581,6 +582,11 @@ scheme_init_list (Scheme_Env *env)
"hash-remove",
2, 2),
env);
scheme_add_global_constant("hash-clear!",
scheme_make_noncm_prim(hash_table_clear_bang,
"hash-clear!",
1, 1),
env);
scheme_add_global_constant("hash-map",
scheme_make_noncm_prim(hash_table_map,
"hash-map",
@ -2416,6 +2422,37 @@ static Scheme_Object *hash_table_remove(int argc, Scheme_Object *argv[])
return (Scheme_Object *)scheme_hash_tree_set((Scheme_Hash_Tree *)v, argv[1], NULL);
}
static Scheme_Object *hash_table_clear_bang(int argc, Scheme_Object *argv[])
{
Scheme_Object *v;
v = argv[0];
if (!(SCHEME_HASHTP(v) && SCHEME_MUTABLEP(v)) && !SCHEME_BUCKTP(v))
scheme_wrong_contract("hash-clear!", "(and/c hash? (not/c immutable?))", 0, argc, argv);
if (SCHEME_NP_CHAPERONEP(v) && (SCHEME_HASHTP(SCHEME_CHAPERONE_VAL(v))
|| SCHEME_BUCKTP(SCHEME_CHAPERONE_VAL(v)))) {
/* Implement `(hash-clear! ht)' as `(hash-for-each ht hash-set!)'
to allow chaperones to interpose. */
Scheme_Object *i, *a[2];
a[0] = v;
while (1) {
i = scheme_hash_table_iterate_start(1, a);
if (SCHEME_FALSEP(i))
break;
a[2] = i;
hash_table_remove_bang(1, a);
}
} else if (SCHEME_BUCKTP(v)) {
scheme_clear_bucket_table((Scheme_Bucket_Table *)v);
} else{
scheme_clear_hash_table((Scheme_Hash_Table *)v);
}
return scheme_void;
}
static void no_post_key(const char *name, Scheme_Object *key, int chap)
{
scheme_contract_error(name,

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

@ -489,6 +489,7 @@ MZ_EXTERN void *scheme_lookup_in_table(Scheme_Bucket_Table *table, const char *k
MZ_EXTERN Scheme_Bucket *scheme_bucket_from_table(Scheme_Bucket_Table *table, const char *key);
MZ_EXTERN int scheme_bucket_table_equal(Scheme_Bucket_Table *t1, Scheme_Bucket_Table *t2);
MZ_EXTERN Scheme_Bucket_Table *scheme_clone_bucket_table(Scheme_Bucket_Table *bt);
MZ_EXTERN void scheme_clear_bucket_table(Scheme_Bucket_Table *bt);
MZ_EXTERN Scheme_Hash_Table *scheme_make_hash_table(int type);
MZ_EXTERN Scheme_Hash_Table *scheme_make_hash_table_equal();
@ -501,7 +502,8 @@ MZ_EXTERN Scheme_Object *scheme_hash_get_atomic(Scheme_Hash_Table *table, Scheme
MZ_EXTERN int scheme_hash_table_equal(Scheme_Hash_Table *t1, Scheme_Hash_Table *t2);
MZ_EXTERN int scheme_is_hash_table_equal(Scheme_Object *o);
MZ_EXTERN int scheme_is_hash_table_eqv(Scheme_Object *o);
MZ_EXTERN Scheme_Hash_Table *scheme_clone_hash_table(Scheme_Hash_Table *bt);
MZ_EXTERN Scheme_Hash_Table *scheme_clone_hash_table(Scheme_Hash_Table *ht);
MZ_EXTERN void scheme_clear_hash_table(Scheme_Hash_Table *ht);
MZ_EXTERN Scheme_Hash_Tree *scheme_make_hash_tree(int kind);
MZ_EXTERN Scheme_Hash_Tree *scheme_hash_tree_set(Scheme_Hash_Tree *tree, Scheme_Object *key, Scheme_Object *val);

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

@ -383,6 +383,7 @@ void *(*scheme_lookup_in_table)(Scheme_Bucket_Table *table, const char *key);
Scheme_Bucket *(*scheme_bucket_from_table)(Scheme_Bucket_Table *table, const char *key);
int (*scheme_bucket_table_equal)(Scheme_Bucket_Table *t1, Scheme_Bucket_Table *t2);
Scheme_Bucket_Table *(*scheme_clone_bucket_table)(Scheme_Bucket_Table *bt);
void (*scheme_clear_bucket_table)(Scheme_Bucket_Table *bt);
Scheme_Hash_Table *(*scheme_make_hash_table)(int type);
Scheme_Hash_Table *(*scheme_make_hash_table_equal)();
Scheme_Hash_Table *(*scheme_make_hash_table_eqv)();
@ -394,7 +395,8 @@ Scheme_Object *(*scheme_hash_get_atomic)(Scheme_Hash_Table *table, Scheme_Object
int (*scheme_hash_table_equal)(Scheme_Hash_Table *t1, Scheme_Hash_Table *t2);
int (*scheme_is_hash_table_equal)(Scheme_Object *o);
int (*scheme_is_hash_table_eqv)(Scheme_Object *o);
Scheme_Hash_Table *(*scheme_clone_hash_table)(Scheme_Hash_Table *bt);
Scheme_Hash_Table *(*scheme_clone_hash_table)(Scheme_Hash_Table *ht);
void (*scheme_clear_hash_table)(Scheme_Hash_Table *ht);
Scheme_Hash_Tree *(*scheme_make_hash_tree)(int kind);
Scheme_Hash_Tree *(*scheme_hash_tree_set)(Scheme_Hash_Tree *tree, Scheme_Object *key, Scheme_Object *val);
Scheme_Object *(*scheme_hash_tree_get)(Scheme_Hash_Tree *tree, Scheme_Object *key);

2
racket/src/racket/src/schemex.inc
View File

@ -282,6 +282,7 @@
scheme_extension_table->scheme_bucket_from_table = scheme_bucket_from_table;
scheme_extension_table->scheme_bucket_table_equal = scheme_bucket_table_equal;
scheme_extension_table->scheme_clone_bucket_table = scheme_clone_bucket_table;
scheme_extension_table->scheme_clear_bucket_table = scheme_clear_bucket_table;
scheme_extension_table->scheme_make_hash_table = scheme_make_hash_table;
scheme_extension_table->scheme_make_hash_table_equal = scheme_make_hash_table_equal;
scheme_extension_table->scheme_make_hash_table_eqv = scheme_make_hash_table_eqv;
@ -294,6 +295,7 @@
scheme_extension_table->scheme_is_hash_table_equal = scheme_is_hash_table_equal;
scheme_extension_table->scheme_is_hash_table_eqv = scheme_is_hash_table_eqv;
scheme_extension_table->scheme_clone_hash_table = scheme_clone_hash_table;
scheme_extension_table->scheme_clear_hash_table = scheme_clear_hash_table;
scheme_extension_table->scheme_make_hash_tree = scheme_make_hash_tree;
scheme_extension_table->scheme_hash_tree_set = scheme_hash_tree_set;
scheme_extension_table->scheme_hash_tree_get = scheme_hash_tree_get;

2
racket/src/racket/src/schemexm.h
View File

@ -282,6 +282,7 @@
#define scheme_bucket_from_table (scheme_extension_table->scheme_bucket_from_table)
#define scheme_bucket_table_equal (scheme_extension_table->scheme_bucket_table_equal)
#define scheme_clone_bucket_table (scheme_extension_table->scheme_clone_bucket_table)
#define scheme_clear_bucket_table (scheme_extension_table->scheme_clear_bucket_table)
#define scheme_make_hash_table (scheme_extension_table->scheme_make_hash_table)
#define scheme_make_hash_table_equal (scheme_extension_table->scheme_make_hash_table_equal)
#define scheme_make_hash_table_eqv (scheme_extension_table->scheme_make_hash_table_eqv)
@ -294,6 +295,7 @@
#define scheme_is_hash_table_equal (scheme_extension_table->scheme_is_hash_table_equal)
#define scheme_is_hash_table_eqv (scheme_extension_table->scheme_is_hash_table_eqv)
#define scheme_clone_hash_table (scheme_extension_table->scheme_clone_hash_table)
#define scheme_clear_hash_table (scheme_extension_table->scheme_clear_hash_table)
#define scheme_make_hash_tree (scheme_extension_table->scheme_make_hash_tree)
#define scheme_hash_tree_set (scheme_extension_table->scheme_hash_tree_set)
#define scheme_hash_tree_get (scheme_extension_table->scheme_hash_tree_get)

2
racket/src/racket/src/schminc.h
View File

@ -14,7 +14,7 @@
#define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 1112
#define EXPECTED_PRIM_COUNT 1113
#define EXPECTED_UNSAFE_COUNT 100
#define EXPECTED_FLFXNUM_COUNT 69
#define EXPECTED_EXTFL_COUNT 45

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

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "5.90.0.6"
#define MZSCHEME_VERSION "5.90.0.7"
#define MZSCHEME_VERSION_X 5
#define MZSCHEME_VERSION_Y 90
#define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 6
#define MZSCHEME_VERSION_W 7
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)