Add dict-set*
This commit is contained in:
parent
a8fc09b49a
commit
2d1787a309
|
@ -11,7 +11,9 @@
|
|||
|
||||
dict-ref
|
||||
dict-set!
|
||||
dict-set*!
|
||||
dict-set
|
||||
dict-set*
|
||||
dict-update!
|
||||
dict-update
|
||||
dict-remove!
|
||||
|
@ -242,6 +244,14 @@
|
|||
[else
|
||||
(raise-type-error 'dict-set! "dict" 0 d key val)]))
|
||||
|
||||
(define (dict-set*! d . pairs)
|
||||
(unless (even? (length pairs))
|
||||
(error 'dict-set*! "expected an even number of association elements, but received an odd number: ~e" pairs))
|
||||
(let loop ([pairs pairs])
|
||||
(unless (null? pairs)
|
||||
(dict-set! d (car pairs) (cadr pairs))
|
||||
(loop (cddr pairs)))))
|
||||
|
||||
(define (dict-set d key val)
|
||||
(cond
|
||||
[(hash? d) (hash-set d key val)]
|
||||
|
@ -264,6 +274,16 @@
|
|||
[else
|
||||
(raise-type-error 'dict-set "dict" 0 d key val)]))
|
||||
|
||||
(define (dict-set* d . pairs)
|
||||
(unless (even? (length pairs))
|
||||
(error 'dict-set* "expected an even number of association elements, but received an odd number: ~e" pairs))
|
||||
(let loop ([d d]
|
||||
[pairs pairs])
|
||||
(if (null? pairs)
|
||||
d
|
||||
(loop (dict-set d (car pairs) (cadr pairs))
|
||||
(cddr pairs)))))
|
||||
|
||||
(define dict-update!
|
||||
(case-lambda
|
||||
[(d key xform)
|
||||
|
|
|
@ -110,6 +110,33 @@ h
|
|||
v
|
||||
]}
|
||||
|
||||
@defproc[(dict-set*! [dict (and/c dict? (not/c immutable?))]
|
||||
[key any/c]
|
||||
[v any/c]
|
||||
...
|
||||
...) void?]{
|
||||
|
||||
Maps each @scheme[key] to each @scheme[v] in @scheme[dict], overwriting any
|
||||
existing mapping for each @scheme[key]. The update can fail with a
|
||||
@scheme[exn:fail:contract] exception if @scheme[dict] is not mutable
|
||||
or if any @scheme[key] is not an allowed key for the dictionary (e.g., not
|
||||
an exact integer in the appropriate range when @scheme[dict] is a
|
||||
@tech{vector}). The update takes place from the left, so later mappings overwrite
|
||||
earlier mappings.
|
||||
|
||||
@examples[
|
||||
#:eval dict-eval
|
||||
(define h (make-hash))
|
||||
(dict-set*! h 'a "apple" 'b "banana")
|
||||
h
|
||||
(define v1 (vector #f #f #f))
|
||||
(dict-set*! v1 0 "apple" 1 "banana")
|
||||
v1
|
||||
(define v2 (vector #f #f #f))
|
||||
(dict-set*! v2 0 "apple" 0 "banana")
|
||||
v2
|
||||
]}
|
||||
|
||||
|
||||
@defproc[(dict-set [dict (and/c dict? immutable?)]
|
||||
[key any/c]
|
||||
|
@ -131,6 +158,30 @@ dictionary.
|
|||
(dict-set '((a . "apple") (b . "beer")) 'b "banana")
|
||||
]}
|
||||
|
||||
@defproc[(dict-set* [dict (and/c dict? immutable?)]
|
||||
[key any/c]
|
||||
[v any/c]
|
||||
...
|
||||
...)
|
||||
(and/c dict? immutable?)]{
|
||||
|
||||
Functionally extends @scheme[dict] by mapping each @scheme[key] to
|
||||
each @scheme[v], overwriting any existing mapping for each @scheme[key], and
|
||||
returning an extended dictionary. The update can fail with a
|
||||
@scheme[exn:fail:contract] exception if @scheme[dict] does not support
|
||||
functional extension or if any @scheme[key] is not an allowed key for the
|
||||
dictionary. The update takes place from the left, so later mappings overwrite
|
||||
earlier mappings.
|
||||
|
||||
@examples[
|
||||
#:eval dict-eval
|
||||
(dict-set* #hash() 'a "apple" 'b "beer")
|
||||
(dict-set* #hash((a . "apple") (b . "beer")) 'b "banana" 'a "anchor")
|
||||
(dict-set* '() 'a "apple" 'b "beer")
|
||||
(dict-set* '((a . "apple") (b . "beer")) 'b "banana" 'a "anchor")
|
||||
(dict-set* '((a . "apple") (b . "beer")) 'b "banana" 'b "balistic")
|
||||
]}
|
||||
|
||||
|
||||
@defproc[(dict-ref [dict dict?]
|
||||
[key any/c]
|
||||
|
|
|
@ -77,6 +77,23 @@
|
|||
(test #t equal? d bigger)))))])
|
||||
(try-add smaller "ONE")
|
||||
(try-add d "ONE")
|
||||
(try-add d 'one))
|
||||
(let ([try-add
|
||||
(lambda (d val)
|
||||
(let ([bigger (if mutable?
|
||||
(begin
|
||||
(err/rt-test (dict-set* smaller 1 val))
|
||||
(dict-set*! smaller 1 (gensym) 1 val)
|
||||
d)
|
||||
(begin
|
||||
(err/rt-test (dict-set*! smaller 1 val))
|
||||
(dict-set* smaller 1 (gensym) 1 val)))])
|
||||
(test cnt dict-count bigger)
|
||||
(when (eq? val 'one)
|
||||
(unless (pair? d)
|
||||
(test #t equal? d bigger)))))])
|
||||
(try-add smaller "ONE")
|
||||
(try-add d "ONE")
|
||||
(try-add d 'one)))))
|
||||
|
||||
(try-simple (vector 'zero 'one 'two) #t #f #f)
|
||||
|
|
Loading…
Reference in New Issue
Block a user