Adding hash-set* and hash-set*bang

This commit is contained in:
Jay McCarthy 2010-08-11 17:39:48 -06:00
parent fadfee7849
commit e06f0e78b2
3 changed files with 80 additions and 4 deletions

View File

@ -8,6 +8,26 @@
(define (hash->list table) (define (hash->list table)
(hash-map table cons)) (hash-map table cons))
(define (hash-set* table . pairs)
(unless (even? (length pairs))
(error 'hash-set* "expected an even number of association elements, but received an odd number: ~e" pairs))
(let loop ([table table]
[pairs pairs])
(if (null? pairs)
table
(loop (hash-set table (car pairs) (cadr pairs))
(cddr pairs)))))
(define (hash-set*! table . pairs)
(unless (even? (length pairs))
(error 'hash-set*! "expected an even number of association elements, but received an odd number: ~e" pairs))
(let loop ([pairs pairs])
(unless (null? pairs)
(hash-set! table (car pairs) (cadr pairs))
(loop (cddr pairs)))))
(provide hash-domain (provide hash-domain
hash-range hash-range
hash->list)) hash->list
hash-set*
hash-set*!))

View File

@ -181,6 +181,18 @@ any existing mapping for @scheme[key].
@see-also-caveats[]} @see-also-caveats[]}
@defproc[(hash-set*! [hash (and/c hash? (not/c immutable?))]
[key any/c]
[v any/c]
...
...) void?]{
Maps each @scheme[key] to each @scheme[v] in @scheme[hash], overwriting
any existing mapping for each @scheme[key]. Mappings are added from the left, so
later mappings overwrite earlier mappings.
@see-also-caveats[]}
@defproc[(hash-set [hash (and/c hash? immutable?)] @defproc[(hash-set [hash (and/c hash? immutable?)]
[key any/c] [key any/c]
@ -193,6 +205,20 @@ returning the extended hash table.
@see-also-mutable-key-caveat[]} @see-also-mutable-key-caveat[]}
@defproc[(hash-set* [hash (and/c hash? immutable?)]
[key any/c]
[v any/c]
...
...)
(and/c hash? immutable?)]{
Functionally extends @scheme[hash] by mapping each @scheme[key] to
@scheme[v], overwriting any existing mapping for each @scheme[key], and
returning the extended hash table. Mappings are added from the left, so
later mappings overwrite earlier mappings.
@see-also-mutable-key-caveat[]}
@defproc[(hash-ref [hash hash?] @defproc[(hash-ref [hash hash?]
[key any/c] [key any/c]
[failure-result any/c (lambda () [failure-result any/c (lambda ()

View File

@ -2363,9 +2363,39 @@
(check-all-bad hash-iterate-key) (check-all-bad hash-iterate-key)
(check-all-bad hash-iterate-value)) (check-all-bad hash-iterate-value))
(test (list 1 2 3) hash-domain #hasheq((1 . 'a)(2 . 'b)(3 . 'c))) (test (list 1 2 3) hash-domain #hasheq((1 . a)(2 . b)(3 . c)))
(test (list 'a 'b 'c) hash-range #hasheq((1 . 'a)(2 . 'b)(3 . 'c))) (test (list 'a 'b 'c) hash-range #hasheq((1 . a)(2 . b)(3 . c)))
(test (list (cons 1 'a) (cons 2 'b) (cons 3 'c)) hash->list #hasheq((1 . 'a)(2 . 'b)(3 . 'c))) (test (list (cons 1 'a) (cons 2 'b) (cons 3 'c)) hash->list #hasheq((1 . a)(2 . b)(3 . c)))
(err/rt-test (hash-set*! im-t 1 2) exn:fail?)
(err/rt-test (hash-set* (make-hasheq null) 1 2) exn:fail?)
(err/rt-test (hash-set* im-t 1 2 3) exn:fail?)
(err/rt-test (hash-set*! (make-hasheq null) 1 2 3) exn:fail?)
(test #t equal? (hash-set* (hasheq 1 'a 3 'b)) (hasheq 1 'a 3 'b))
(test #t equal? (hasheq 1 2 3 4)
(hash-set* (hasheq 1 'a 3 'b)
1 (gensym)
1 2
3 (gensym)
3 4))
(test #t equal? (make-hasheq (list (cons 1 'a) (cons 3 'b)))
(let ([ht (make-hasheq (list (cons 1 'a) (cons 3 'b)))])
(hash-set*! ht)
ht))
(test #t equal? (make-hasheq (list (cons 1 2) (cons 3 'b)))
(let ([ht (make-hasheq (list (cons 1 'a) (cons 3 'b)))])
(hash-set*! ht
1 2)
ht))
(test #t equal? (make-hasheq (list (cons 1 2) (cons 3 4)))
(let ([ht (make-hasheq (list (cons 1 'a) (cons 3 'b)))])
(hash-set*! ht
1 (gensym)
1 2
3 (gensym)
3 4)
ht))
(arity-test make-immutable-hash 1 1) (arity-test make-immutable-hash 1 1)
(arity-test make-immutable-hasheq 1 1) (arity-test make-immutable-hasheq 1 1)