Extended the gen:dict interface; also added some dict and hash operations.
- Added hash-empty?, hash-clear, and hash-clear! for hash tables. - Added dict-empty?, dict-clear, and dict-clear! for dictionaries. - Made all dict functions exported by racket/dict into generic methods; turned the existing implementations into fallbacks.
This commit is contained in:
Carl Eastlund
parent
97b78ace5b
commit
81bcd73aa7
|
|
@ -8,7 +8,20 @@
|
|||
;; Currently relying on the `map' an `for-each' to test `dict-iterate-...',
|
||||
;; and custom hashes to test `prop:dict' use.
|
||||
|
||||
(define (try-simple d mutable? can-remove? can-update? [orig-one 1])
|
||||
(define (try-simple d ordered? mutable? can-remove? can-update? [orig-one 1])
|
||||
|
||||
;; Assuming that dictionaries with nondeterministic order, e.g. hash tables,
|
||||
;; will at least have some internal order to follow, and will only differ in
|
||||
;; whether they proceed left-to-right or right-to-left for each function.
|
||||
(define test/order
|
||||
(if ordered?
|
||||
test
|
||||
(lambda (expected name actual)
|
||||
(let ([rev (reverse expected)])
|
||||
(if (equal? rev actual)
|
||||
(test rev name actual)
|
||||
(test expected name actual))))))
|
||||
|
||||
(test #t dict? d)
|
||||
|
||||
(test 'one dict-ref d 1)
|
||||
|
|
@ -25,24 +38,24 @@
|
|||
(test can-remove? dict-can-remove-keys? d)
|
||||
(test can-update? dict-can-functional-set? d)
|
||||
|
||||
(test (dict-map d cons) 'dict->list (dict->list d))
|
||||
(test (dict-map d (λ (k v) k)) 'dict-keys (dict-keys d))
|
||||
(test (dict-map d (λ (k v) v)) 'dict-values (dict-values d))
|
||||
(test/order (dict-map d cons) 'dict->list (dict->list d))
|
||||
(test/order (dict-map d (λ (k v) k)) 'dict-keys (dict-keys d))
|
||||
(test/order (dict-map d (λ (k v) v)) 'dict-values (dict-values d))
|
||||
|
||||
(test (dict-map d cons) 'in-dict
|
||||
(for/list ([(k v) (in-dict d)])
|
||||
(cons k v)))
|
||||
(test (dict-map d cons) 'in-dict/keys/vals
|
||||
(for/list ([k (in-dict-keys d)]
|
||||
[v (in-dict-values d)])
|
||||
(cons k v)))
|
||||
(test (dict-map d cons) 'in-dict-pairs
|
||||
(for/list ([p (in-dict-pairs d)])
|
||||
p))
|
||||
(test/order (dict-map d cons) 'in-dict
|
||||
(for/list ([(k v) (in-dict d)])
|
||||
(cons k v)))
|
||||
(test/order (dict-map d cons) 'in-dict/keys/vals
|
||||
(for/list ([k (in-dict-keys d)]
|
||||
[v (in-dict-values d)])
|
||||
(cons k v)))
|
||||
(test/order (dict-map d cons) 'in-dict-pairs
|
||||
(for/list ([p (in-dict-pairs d)])
|
||||
p))
|
||||
|
||||
(let ([l null])
|
||||
(dict-for-each d (lambda (k v) (set! l (cons (cons k v) l))))
|
||||
(test (reverse l) dict-map d cons)
|
||||
(test/order (reverse l) 'dict-for-each/map (dict-map d cons))
|
||||
(test (length l) dict-count d))
|
||||
|
||||
(if (not can-remove?)
|
||||
|
|
@ -104,8 +117,8 @@
|
|||
(try-add d "ONE")
|
||||
(try-add d 'one)))))
|
||||
|
||||
(try-simple (vector 'zero 'one 'two) #t #f #f)
|
||||
(try-simple #hash((1 . one) (#f . 7)) #f #t #t)
|
||||
(try-simple (vector 'zero 'one 'two) #t #t #f #f)
|
||||
(try-simple #hash((1 . one) (#f . 7)) #f #f #t #t)
|
||||
|
||||
(let ([d (make-hasheq '((1 . one) (#f . 7)))])
|
||||
(test 'one dict-ref! d 1 (gensym))
|
||||
|
|
@ -114,11 +127,11 @@
|
|||
(test 'three dict-ref! d 3 (λ () 'three))
|
||||
(test 'three dict-ref d 3))
|
||||
|
||||
(try-simple #hasheq((1 . one) (#f . 7)) #f #t #t)
|
||||
(try-simple (hash-copy #hash((1 . one) (#f . 7))) #t #t #f)
|
||||
(try-simple (hash-copy #hasheq((1 . one) (#f . 7))) #t #t #f)
|
||||
(try-simple '((0 . zero) (1 . one)) #f #t #t)
|
||||
(try-simple '((1 . one) (0 . zero)) #f #t #t)
|
||||
(try-simple #hasheq((1 . one) (#f . 7)) #f #f #t #t)
|
||||
(try-simple (hash-copy #hash((1 . one) (#f . 7))) #f #t #t #f)
|
||||
(try-simple (hash-copy #hasheq((1 . one) (#f . 7))) #f #t #t #f)
|
||||
(try-simple '((0 . zero) (1 . one)) #t #f #t #t)
|
||||
(try-simple '((1 . one) (0 . zero)) #t #f #t #t)
|
||||
(try-simple (let ([h (make-custom-hash (lambda (a b)
|
||||
(string=? (format "~a" a)
|
||||
(format "~a" b)))
|
||||
|
|
@ -127,7 +140,7 @@
|
|||
(dict-set! h "1" 'one)
|
||||
(dict-set! h "2" 'two)
|
||||
h)
|
||||
#t #t #f
|
||||
#f #t #t #f
|
||||
"1")
|
||||
(try-simple (let* ([h (make-immutable-custom-hash
|
||||
(lambda (a b)
|
||||
|
|
@ -138,7 +151,7 @@
|
|||
[h (dict-set h "1" 'one)]
|
||||
[h (dict-set h "2" 'two)])
|
||||
h)
|
||||
#f #t #t
|
||||
#f #f #t #t
|
||||
"1")
|
||||
(let ([s1 (make-string 1 #\1)]
|
||||
[s2 (make-string 1 #\2)])
|
||||
|
|
@ -150,7 +163,7 @@
|
|||
(dict-set! h s1 'one)
|
||||
(dict-set! h s2 'two)
|
||||
h)
|
||||
#t #t #f
|
||||
#f #t #t #f
|
||||
"1")
|
||||
;; preserve from GC:
|
||||
(list s1 s2))
|
||||
|
|
|
|||
|
|
@ -2,6 +2,42 @@
|
|||
(require racket/contract/base
|
||||
"private/dict.rkt")
|
||||
|
||||
(define (dict-supports/c . syms)
|
||||
(if (null? syms)
|
||||
dict?
|
||||
(flat-named-contract
|
||||
`(dict-supports/c . ,syms)
|
||||
(lambda (x)
|
||||
(and (dict? x)
|
||||
(for/and ([sym (in-list syms)])
|
||||
(dict-supports? x sym)))))))
|
||||
|
||||
(define dict-method-name/c
|
||||
(or/c 'dict-ref
|
||||
'dict-set!
|
||||
'dict-set
|
||||
'dict-remove!
|
||||
'dict-remove
|
||||
'dict-count
|
||||
'dict-iterate-first
|
||||
'dict-iterate-next
|
||||
'dict-iterate-key
|
||||
'dict-iterate-value
|
||||
'dict-has-key?
|
||||
'dict-ref!
|
||||
'dict-set*!
|
||||
'dict-set*
|
||||
'dict-update!
|
||||
'dict-update
|
||||
'dict-map
|
||||
'dict-for-each
|
||||
'dict-keys
|
||||
'dict-values
|
||||
'dict->list
|
||||
'dict-empty?
|
||||
'dict-clear
|
||||
'dict-clear!))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
(define-values (prop:dict/c dict/c-struct? dict/c-struct-ref)
|
||||
|
|
@ -68,21 +104,21 @@
|
|||
([default any/c])
|
||||
any)) ;; because default can be multi-valued procedure
|
||||
(define dict-set!-contract
|
||||
(->i ([d (and/c dict? dict-mutable?)]
|
||||
(->i ([d (dict-supports/c 'dict-set!)]
|
||||
[k (d) (dict-key-contract d)]
|
||||
[value (d) (dict-value-contract d)])
|
||||
[_r void?]))
|
||||
(define dict-set-contract
|
||||
(->i ([d (and/c dict? dict-can-functional-set?)]
|
||||
(->i ([d (dict-supports/c 'dict-set)]
|
||||
[k (d) (dict-key-contract d)]
|
||||
[value (d) (dict-value-contract d)])
|
||||
[_r dict?]))
|
||||
(define dict-remove!-contract
|
||||
(->i ([d (and/c dict? dict-mutable? dict-can-remove-keys?)]
|
||||
(->i ([d (dict-supports/c 'dict-remove!)]
|
||||
[k (d) (dict-key-contract d)])
|
||||
[_r void?]))
|
||||
(define dict-remove-contract
|
||||
(->i ([d (and/c dict? dict-can-functional-set? dict-can-remove-keys?)]
|
||||
(->i ([d (dict-supports/c 'dict-remove)]
|
||||
[k (d) (dict-key-contract d)])
|
||||
[_r dict?]))
|
||||
(define dict-count-contract
|
||||
|
|
@ -143,7 +179,7 @@
|
|||
[dict-ref
|
||||
dict-ref-contract]
|
||||
[dict-ref!
|
||||
(->i ([d (and/c dict? dict-mutable?)]
|
||||
(->i ([d (dict-supports/c 'dict-set!)]
|
||||
[k (d) (dict-key-contract d)]
|
||||
[default (d) (or/c (dict-value-contract d) (-> (dict-value-contract d)))]) ;; use if/c ?
|
||||
[_r (d) (dict-value-contract d)])]
|
||||
|
|
@ -152,7 +188,7 @@
|
|||
[dict-set
|
||||
dict-set-contract]
|
||||
[dict-set*!
|
||||
(->i ([d (and/c dict? dict-mutable?)])
|
||||
(->i ([d (dict-supports/c 'dict-set!)])
|
||||
#:rest [rst (d) (let ([key/c (dict-key-contract d)]
|
||||
[val/c (dict-value-contract d)])
|
||||
(letrec ([args/c
|
||||
|
|
@ -163,7 +199,7 @@
|
|||
args/c)))]
|
||||
[_r void?])]
|
||||
[dict-set*
|
||||
(->i ([d (and/c dict? dict-can-functional-set?)])
|
||||
(->i ([d (dict-supports/c 'dict-set)])
|
||||
#:rest [rst (d) (let ([key/c (dict-key-contract d)]
|
||||
[val/c (dict-value-contract d)])
|
||||
(letrec ([args/c
|
||||
|
|
@ -174,13 +210,13 @@
|
|||
args/c)))]
|
||||
[_r dict?])]
|
||||
[dict-update!
|
||||
(->i ([d (and/c dict? dict-mutable?)]
|
||||
(->i ([d (dict-supports/c 'dict-set!)]
|
||||
[k (d) (dict-key-contract d)]
|
||||
[update (d) (-> (dict-value-contract d) (dict-value-contract d))])
|
||||
([default (d) (or/c (dict-value-contract d) (-> (dict-value-contract d)))]) ;; use if/c
|
||||
[_r void?])]
|
||||
[dict-update
|
||||
(->i ([d (and/c dict? dict-can-functional-set?)]
|
||||
(->i ([d (dict-supports/c 'dict-set)]
|
||||
[k (d) (dict-key-contract d)]
|
||||
[update (d) (-> (dict-value-contract d) (dict-value-contract d))])
|
||||
([default (d) (or/c (dict-value-contract d) (-> (dict-value-contract d)))]) ;; use if/c ?
|
||||
|
|
@ -215,7 +251,24 @@
|
|||
[_r (d) (listof (dict-value-contract d))])]
|
||||
[dict->list
|
||||
(->i ([d dict?])
|
||||
[_r (d) (listof (cons/c (dict-key-contract d) (dict-value-contract d)))])])
|
||||
[_r (d) (listof (cons/c (dict-key-contract d) (dict-value-contract d)))])]
|
||||
|
||||
[dict-empty? (-> dict? boolean?)]
|
||||
[dict-clear
|
||||
(->i ([d dict?])
|
||||
[_r (d) (apply dict-supports/c
|
||||
(for/list ([sym (in-list '(dict-set dict-set!))]
|
||||
#:when (dict-supports? d sym))
|
||||
sym))])]
|
||||
[dict-clear!
|
||||
(->i ([d (dict-supports/c 'dict-remove!)])
|
||||
[_r void?]
|
||||
#:post (d) (dict-empty? d))]
|
||||
|
||||
[dict-supports?
|
||||
(->* [dict?] [] #:rest (listof dict-method-name/c) boolean?)]
|
||||
[dict-supports/c
|
||||
(->* [] [] #:rest (listof dict-method-name/c) flat-contract?)])
|
||||
|
||||
(provide gen:dict
|
||||
prop:dict
|
||||
|
|
|
|||
|
|
@ -35,7 +35,7 @@
|
|||
(raise-argument-error 'dict-can-functional-set? "dict?" d))
|
||||
(dict-supports? d 'dict-set))
|
||||
|
||||
(define (dict-has-key? d k)
|
||||
(define (fallback-has-key? d k)
|
||||
(define not-there (gensym))
|
||||
(not (eq? not-there (dict-ref d k not-there))))
|
||||
|
||||
|
|
@ -63,7 +63,9 @@
|
|||
[(procedure? default) (default)]
|
||||
[else default]))
|
||||
|
||||
(define (dict-ref! d key new)
|
||||
(define (fallback-ref! d key new)
|
||||
(unless (dict-supports? d 'dict-set!)
|
||||
(raise-argument-error 'dict-ref! "(dict-supports/c 'dict-set!)" d))
|
||||
(define not-there (gensym))
|
||||
(define v (dict-ref d key not-there))
|
||||
(if (eq? not-there v)
|
||||
|
|
@ -72,13 +74,21 @@
|
|||
n)
|
||||
v))
|
||||
|
||||
(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 (fallback-set*! d . pairs0)
|
||||
(unless (dict-supports? d 'dict-set!)
|
||||
(raise-argument-error 'dict-set*! "(dict-supports/c 'dict-set!)" d))
|
||||
(let loop ([pairs pairs0])
|
||||
(cond
|
||||
[(null? pairs) (void)]
|
||||
[(null? (cdr pairs))
|
||||
(raise-arguments-error
|
||||
'dict-set*!
|
||||
"expected an even number of association elements, but received an odd number"
|
||||
"association elements"
|
||||
pairs0)]
|
||||
[else
|
||||
(dict-set! d (car pairs) (cadr pairs))
|
||||
(loop (cddr pairs))])))
|
||||
|
||||
(define (assoc-set d key val)
|
||||
(unless (assoc? d)
|
||||
|
|
@ -92,28 +102,43 @@
|
|||
(cons (cons key val) (cdr xd))
|
||||
(cons a (loop (cdr xd)))))])))
|
||||
|
||||
(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 (fallback-set* d . pairs0)
|
||||
(unless (dict-supports? d 'dict-set)
|
||||
(raise-argument-error 'dict-set* "(dict-supports/c 'dict-set)" d))
|
||||
(let loop ([d d]
|
||||
[pairs pairs0])
|
||||
(cond
|
||||
[(null? pairs) d]
|
||||
[(null? (cdr pairs))
|
||||
(raise-arguments-error
|
||||
'dict-set*
|
||||
"expected an even number of association elements, but received an odd number"
|
||||
"association elements"
|
||||
pairs0)]
|
||||
[else
|
||||
(loop (dict-set d (car pairs) (cadr pairs))
|
||||
(cddr pairs))])))
|
||||
|
||||
(define dict-update!
|
||||
(define fallback-update!
|
||||
(case-lambda
|
||||
[(d key xform)
|
||||
(unless (dict-supports? d 'dict-set!)
|
||||
(raise-argument-error 'dict-update! "(dict-supports/c 'dict-set!)" d))
|
||||
(dict-set! d key (xform (dict-ref d key)))]
|
||||
[(d key xform default)
|
||||
(unless (dict-supports? d 'dict-set!)
|
||||
(raise-argument-error 'dict-update! "(dict-supports/c 'dict-set!)" d))
|
||||
(dict-set! d key (xform (dict-ref d key default)))]))
|
||||
|
||||
(define dict-update
|
||||
(define fallback-update
|
||||
(case-lambda
|
||||
[(d key xform)
|
||||
(unless (dict-supports? d 'dict-set)
|
||||
(raise-argument-error 'dict-update "(dict-supports/c 'dict-set)" d))
|
||||
(dict-set d key (xform (dict-ref d key)))]
|
||||
[(d key xform default)
|
||||
(unless (dict-supports? d 'dict-set)
|
||||
(raise-argument-error 'dict-update "(dict-supports/c 'dict-set)" d))
|
||||
(dict-set d key (xform (dict-ref d key default)))]))
|
||||
|
||||
(define (assoc-remove d key)
|
||||
|
|
@ -199,6 +224,103 @@
|
|||
i)]
|
||||
[else (raise-argument-error 'dict-iterate-value "dict?" d)]))
|
||||
|
||||
(define (vector-has-key? vec key)
|
||||
(and (exact-nonnegative-integer? key)
|
||||
(< key (vector-length vec))))
|
||||
|
||||
(define (vector-map-as-dict vec proc)
|
||||
(unless (and (procedure? proc)
|
||||
(procedure-arity-includes? proc 2))
|
||||
(raise-argument-error 'dict-map "(procedure-arity-includes/c 2)" proc))
|
||||
(for/list ([k (in-naturals)] [v (in-vector vec)])
|
||||
(proc k v)))
|
||||
|
||||
(define (vector-for-each vec proc)
|
||||
(unless (and (procedure? proc)
|
||||
(procedure-arity-includes? proc 2))
|
||||
(raise-argument-error 'dict-for-each "(procedure-arity-includes/c 2)" proc))
|
||||
(for ([k (in-naturals)] [v (in-vector vec)])
|
||||
(proc k v)))
|
||||
|
||||
(define (vector-keys vec)
|
||||
(build-list (vector-length vec) values))
|
||||
|
||||
(define (vector->assoc vec)
|
||||
(for/list ([k (in-naturals)] [v (in-vector vec)])
|
||||
(cons k v)))
|
||||
|
||||
(define (vector-empty? vec)
|
||||
(zero? (vector-length vec)))
|
||||
|
||||
(define (assoc-has-key? d key)
|
||||
(unless (assoc? d)
|
||||
(raise-argument-error 'dict-has-key? "dict?" d))
|
||||
(pair? (assoc key d)))
|
||||
|
||||
(define (assoc-map d proc)
|
||||
(for/list ([x (in-list d)])
|
||||
(unless (pair? x)
|
||||
(raise-argument-error 'dict-map "dict?" d))
|
||||
(proc (car x) (cdr x))))
|
||||
|
||||
(define (assoc-for-each d proc)
|
||||
(for ([x (in-list d)])
|
||||
(unless (pair? x)
|
||||
(raise-argument-error 'dict-for-each "dict?" d))
|
||||
(proc (car x) (cdr x))))
|
||||
|
||||
(define (assoc-keys d)
|
||||
(for/list ([x (in-list d)])
|
||||
(unless (pair? x)
|
||||
(raise-argument-error 'dict-keys "dict?" d))
|
||||
(car x)))
|
||||
|
||||
(define (assoc-values d)
|
||||
(for/list ([x (in-list d)])
|
||||
(unless (pair? x)
|
||||
(raise-argument-error 'dict-values "dict?" d))
|
||||
(cdr x)))
|
||||
|
||||
(define (assoc-clear d) '())
|
||||
|
||||
(define (fallback-clear d)
|
||||
(unless (dict-supports? d 'dict-remove)
|
||||
(raise-argument-error 'dict-clear "(dict-supports/c 'dict-remove)" d))
|
||||
(for/fold ([d d]) ([k (in-dict-keys d)])
|
||||
(dict-remove d k)))
|
||||
|
||||
(define (fallback-clear! d)
|
||||
(unless (dict-supports? d 'dict-remove!)
|
||||
(raise-argument-error 'dict-clear! "(dict-supports/c 'dict-remove!)" d))
|
||||
(let loop ()
|
||||
(define i (dict-iterate-first d))
|
||||
(when i
|
||||
(dict-remove! d (dict-iterate-key d i))
|
||||
(loop))))
|
||||
|
||||
(define (fallback-empty? d)
|
||||
(if (dict-iterate-first d) #t #f))
|
||||
|
||||
(define (fallback-map d f)
|
||||
(for/list ([(k v) (:in-dict d)])
|
||||
(f k v)))
|
||||
|
||||
(define (fallback-for-each d f)
|
||||
(for ([(k v) (:in-dict d)])
|
||||
(f k v)))
|
||||
|
||||
(define (fallback-keys d)
|
||||
(for/list ([k (:in-dict-keys d)])
|
||||
k))
|
||||
|
||||
(define (fallback-values d)
|
||||
(for/list ([v (:in-dict-values d)])
|
||||
v))
|
||||
|
||||
(define (fallback->list d)
|
||||
(for/list ([k*v (in-dict-pairs d)])
|
||||
k*v))
|
||||
|
||||
(define-primitive-generics
|
||||
(dict gen:dict prop:gen:dict prop:gen:dict-methods dict? dict-supports?)
|
||||
#:fast-defaults
|
||||
|
|
@ -210,7 +332,19 @@
|
|||
(define dict-iterate-first hash-iterate-first)
|
||||
(define dict-iterate-next hash-iterate-next)
|
||||
(define dict-iterate-key hash-iterate-key)
|
||||
(define dict-iterate-value hash-iterate-value)]
|
||||
(define dict-iterate-value hash-iterate-value)
|
||||
(define dict-has-key? hash-has-key?)
|
||||
(define dict-ref! hash-ref!)
|
||||
(define dict-set*! hash-set*!)
|
||||
(define dict-update! hash-update!)
|
||||
(define dict-map hash-map)
|
||||
(define dict-for-each hash-for-each)
|
||||
(define dict-keys hash-keys)
|
||||
(define dict-values hash-values)
|
||||
(define dict->list hash->list)
|
||||
(define dict-empty? hash-empty?)
|
||||
(define dict-clear hash-clear)
|
||||
(define dict-clear! hash-clear!)]
|
||||
[immutable-hash? immutable-hash?
|
||||
(define dict-ref hash-ref)
|
||||
(define dict-set hash-set)
|
||||
|
|
@ -219,7 +353,17 @@
|
|||
(define dict-iterate-first hash-iterate-first)
|
||||
(define dict-iterate-next hash-iterate-next)
|
||||
(define dict-iterate-key hash-iterate-key)
|
||||
(define dict-iterate-value hash-iterate-value)]
|
||||
(define dict-iterate-value hash-iterate-value)
|
||||
(define dict-has-key? hash-has-key?)
|
||||
(define dict-set* hash-set*)
|
||||
(define dict-update hash-update)
|
||||
(define dict-map hash-map)
|
||||
(define dict-for-each hash-for-each)
|
||||
(define dict-keys hash-keys)
|
||||
(define dict-values hash-values)
|
||||
(define dict->list hash->list)
|
||||
(define dict-empty? hash-empty?)
|
||||
(define dict-clear hash-clear)]
|
||||
[mutable-vector? mutable-vector?
|
||||
(define dict-ref vector-ref-as-dict)
|
||||
(define dict-set! vector-set!)
|
||||
|
|
@ -227,14 +371,28 @@
|
|||
(define dict-iterate-first vector-iterate-first)
|
||||
(define dict-iterate-next vector-iterate-next)
|
||||
(define dict-iterate-key vector-iterate-key)
|
||||
(define dict-iterate-value vector-iterate-value)]
|
||||
(define dict-iterate-value vector-iterate-value)
|
||||
(define dict-has-key? vector-has-key?)
|
||||
(define dict-map vector-map-as-dict)
|
||||
(define dict-for-each vector-for-each)
|
||||
(define dict-keys vector-keys)
|
||||
(define dict-values vector->list)
|
||||
(define dict->list vector->assoc)
|
||||
(define dict-empty? vector-empty?)]
|
||||
[immutable-vector? immutable-vector?
|
||||
(define dict-ref vector-ref-as-dict)
|
||||
(define dict-count vector-length)
|
||||
(define dict-iterate-first vector-iterate-first)
|
||||
(define dict-iterate-next vector-iterate-next)
|
||||
(define dict-iterate-key vector-iterate-key)
|
||||
(define dict-iterate-value vector-iterate-value)]
|
||||
(define dict-iterate-value vector-iterate-value)
|
||||
(define dict-has-key? vector-has-key?)
|
||||
(define dict-map vector-map-as-dict)
|
||||
(define dict-for-each vector-for-each)
|
||||
(define dict-keys vector-keys)
|
||||
(define dict-values vector->list)
|
||||
(define dict->list vector->assoc)
|
||||
(define dict-empty? vector-empty?)]
|
||||
[assoc? list?
|
||||
(define dict-ref assoc-ref)
|
||||
(define dict-set assoc-set)
|
||||
|
|
@ -243,9 +401,31 @@
|
|||
(define dict-iterate-first assoc-iterate-first)
|
||||
(define dict-iterate-next assoc-iterate-next)
|
||||
(define dict-iterate-key assoc-iterate-key)
|
||||
(define dict-iterate-value assoc-iterate-value)])
|
||||
(define dict-iterate-value assoc-iterate-value)
|
||||
(define dict-has-key? assoc-has-key?)
|
||||
(define dict-map assoc-map)
|
||||
(define dict-for-each assoc-for-each)
|
||||
(define dict-keys assoc-keys)
|
||||
(define dict-values assoc-values)
|
||||
(define dict->list values)
|
||||
(define dict-empty? null?)
|
||||
(define dict-clear assoc-clear)])
|
||||
#:defaults ()
|
||||
#:fallbacks ()
|
||||
#:fallbacks
|
||||
[(define dict-has-key? fallback-has-key?)
|
||||
(define dict-ref! fallback-ref!)
|
||||
(define dict-set*! fallback-set*!)
|
||||
(define dict-set* fallback-set*)
|
||||
(define dict-update! fallback-update!)
|
||||
(define dict-update fallback-update)
|
||||
(define dict-map fallback-map)
|
||||
(define dict-for-each fallback-for-each)
|
||||
(define dict-keys fallback-keys)
|
||||
(define dict-values fallback-values)
|
||||
(define dict->list fallback->list)
|
||||
(define dict-empty? fallback-empty?)
|
||||
(define dict-clear fallback-clear)
|
||||
(define dict-clear! fallback-clear!)]
|
||||
#:derive-properties ()
|
||||
(dict-ref dict key [default])
|
||||
(dict-set! dict key val)
|
||||
|
|
@ -256,7 +436,21 @@
|
|||
(dict-iterate-first dict)
|
||||
(dict-iterate-next dict pos)
|
||||
(dict-iterate-key dict pos)
|
||||
(dict-iterate-value dict pos))
|
||||
(dict-iterate-value dict pos)
|
||||
(dict-has-key? dict key)
|
||||
(dict-ref! dict key default)
|
||||
(dict-set*! dict . pairs)
|
||||
(dict-set* dict . pairs)
|
||||
(dict-update! dict key proc [default])
|
||||
(dict-update dict key proc [default])
|
||||
(dict-map dict proc)
|
||||
(dict-for-each dict proc)
|
||||
(dict-keys dict)
|
||||
(dict-values dict)
|
||||
(dict->list dict)
|
||||
(dict-empty? dict)
|
||||
(dict-clear dict)
|
||||
(dict-clear! dict))
|
||||
|
||||
(define (check-method who v i req? name arity [alt #f])
|
||||
(define m (vector-ref v i))
|
||||
|
|
@ -411,26 +605,6 @@
|
|||
val-true
|
||||
val+pos-true))))
|
||||
|
||||
(define (dict-map d f)
|
||||
(for/list ([(k v) (:in-dict d)])
|
||||
(f k v)))
|
||||
|
||||
(define (dict-for-each d f)
|
||||
(for ([(k v) (:in-dict d)])
|
||||
(f k v)))
|
||||
|
||||
(define (dict-keys d)
|
||||
(for/list ([k (:in-dict-keys d)])
|
||||
k))
|
||||
|
||||
(define (dict-values d)
|
||||
(for/list ([v (:in-dict-values d)])
|
||||
v))
|
||||
|
||||
(define (dict->list d)
|
||||
(for/list ([k*v (in-dict-pairs d)])
|
||||
k*v))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
(struct hash-box (key))
|
||||
|
|
@ -485,7 +659,104 @@
|
|||
(define (custom-hash-iterate-value d i)
|
||||
(hash-iterate-value (custom-hash-table d) i))
|
||||
|
||||
(struct custom-hash (table make-box)
|
||||
(define (custom-hash-has-key? d key)
|
||||
(hash-has-key? (custom-hash-table d) ((custom-hash-make-box d) key)))
|
||||
|
||||
(define (custom-hash-ref! d key new)
|
||||
(hash-ref! (custom-hash-table d) ((custom-hash-make-box d) key) new))
|
||||
|
||||
(define (custom-hash-set*! d . pairs0)
|
||||
(define table (custom-hash-table d))
|
||||
(define make-box (custom-hash-make-box d))
|
||||
(let loop ([pairs pairs0])
|
||||
(cond
|
||||
[(null? pairs) (void)]
|
||||
[(null? (cdr pairs))
|
||||
(raise-arguments-error
|
||||
'dict-set*!
|
||||
"expected an even number of association elements, but received an odd number"
|
||||
"association elements"
|
||||
pairs0)]
|
||||
[else
|
||||
(hash-set! table (make-box (car pairs)) (cadr pairs))
|
||||
(loop (cddr pairs))])))
|
||||
|
||||
(define (custom-hash-set* d . pairs0)
|
||||
(define make-box (custom-hash-make-box d))
|
||||
(let loop ([table (custom-hash-table d)]
|
||||
[pairs pairs0])
|
||||
(cond
|
||||
[(null? pairs) (immutable-custom-hash table make-box)]
|
||||
[(null? (cdr pairs))
|
||||
(raise-arguments-error
|
||||
'dict-set*
|
||||
"expected an even number of association elements, but received an odd number"
|
||||
"association elements"
|
||||
pairs0)]
|
||||
[else
|
||||
(loop (hash-set table (make-box (car pairs)) (cadr pairs))
|
||||
(cddr pairs))])))
|
||||
|
||||
(define custom-hash-update!
|
||||
(case-lambda
|
||||
[(d key proc)
|
||||
(define make-box (custom-hash-make-box d))
|
||||
(hash-update! (custom-hash-table d) (make-box key) proc)]
|
||||
[(d key proc new)
|
||||
(define make-box (custom-hash-make-box d))
|
||||
(hash-update! (custom-hash-table d) (make-box key) proc new)]))
|
||||
|
||||
(define custom-hash-update
|
||||
(case-lambda
|
||||
[(d key proc)
|
||||
(define make-box (custom-hash-make-box d))
|
||||
(define table (hash-update (custom-hash-table d) (make-box key) proc))
|
||||
(immutable-custom-hash table make-box)]
|
||||
[(d key proc new)
|
||||
(define make-box (custom-hash-make-box d))
|
||||
(define table (hash-update (custom-hash-table d) (make-box key) proc new))
|
||||
(immutable-custom-hash table make-box)]))
|
||||
|
||||
(define (custom-hash-map d proc)
|
||||
(hash-map (custom-hash-table d)
|
||||
(lambda (boxed val)
|
||||
(proc (hash-box-key boxed) val))))
|
||||
|
||||
(define (custom-hash-for-each d proc)
|
||||
(hash-for-each (custom-hash-table d)
|
||||
(lambda (boxed val)
|
||||
(proc (hash-box-key boxed) val))))
|
||||
|
||||
;; custom-hash-keys, -values, and ->list:
|
||||
;; We use for/fold rather than for/list to save on the final reverse
|
||||
;; because the order is nondeterministic anyway.
|
||||
|
||||
(define (custom-hash-keys d)
|
||||
(for/fold ([keys '()]) ([boxed (in-hash-keys (custom-hash-table d))])
|
||||
(cons (hash-box-key boxed) keys)))
|
||||
|
||||
(define (custom-hash-values d)
|
||||
(for/fold ([vals '()]) ([val (in-hash-values (custom-hash-table d))])
|
||||
(cons val vals)))
|
||||
|
||||
(define (custom-hash->list d)
|
||||
(for/fold ([pairs '()]) ([(boxed val) (in-hash (custom-hash-table d))])
|
||||
(cons (cons (hash-box-key boxed) val) pairs)))
|
||||
|
||||
(define (custom-hash-empty? d)
|
||||
(hash-empty? (custom-hash-table d)))
|
||||
|
||||
(define (custom-hash-clear d)
|
||||
(if (immutable-custom-hash? d)
|
||||
(immutable-custom-hash (hash-clear (custom-hash-table d))
|
||||
(custom-hash-make-box d))
|
||||
(custom-hash (hash-clear (custom-hash-table d))
|
||||
(custom-hash-make-box d))))
|
||||
|
||||
(define (custom-hash-clear! d)
|
||||
(set-custom-hash-table! d (hash-clear (custom-hash-table d))))
|
||||
|
||||
(struct custom-hash ([table #:mutable] make-box)
|
||||
#:methods gen:dict
|
||||
[(define dict-ref custom-hash-ref)
|
||||
(define dict-set! custom-hash-set!)
|
||||
|
|
@ -494,7 +765,19 @@
|
|||
(define dict-iterate-first custom-hash-iterate-first)
|
||||
(define dict-iterate-next custom-hash-iterate-next)
|
||||
(define dict-iterate-key custom-hash-iterate-key)
|
||||
(define dict-iterate-value custom-hash-iterate-value)]
|
||||
(define dict-iterate-value custom-hash-iterate-value)
|
||||
(define dict-has-key? custom-hash-has-key?)
|
||||
(define dict-ref! custom-hash-ref!)
|
||||
(define dict-set*! custom-hash-set*!)
|
||||
(define dict-update! custom-hash-update!)
|
||||
(define dict-map custom-hash-map)
|
||||
(define dict-for-each custom-hash-for-each)
|
||||
(define dict-keys custom-hash-keys)
|
||||
(define dict-values custom-hash-values)
|
||||
(define dict->list custom-hash->list)
|
||||
(define dict-empty? custom-hash-empty?)
|
||||
(define dict-clear custom-hash-clear)
|
||||
(define dict-clear! custom-hash-clear!)]
|
||||
#:methods gen:equal+hash
|
||||
[(define (equal-proc a b recur)
|
||||
(and (recur (custom-hash-make-box a)
|
||||
|
|
@ -515,7 +798,17 @@
|
|||
(define dict-iterate-first custom-hash-iterate-first)
|
||||
(define dict-iterate-next custom-hash-iterate-next)
|
||||
(define dict-iterate-key custom-hash-iterate-key)
|
||||
(define dict-iterate-value custom-hash-iterate-value)])
|
||||
(define dict-iterate-value custom-hash-iterate-value)
|
||||
(define dict-has-key? custom-hash-has-key?)
|
||||
(define dict-set* custom-hash-set*)
|
||||
(define dict-update custom-hash-update)
|
||||
(define dict-map custom-hash-map)
|
||||
(define dict-for-each custom-hash-for-each)
|
||||
(define dict-keys custom-hash-keys)
|
||||
(define dict-values custom-hash-values)
|
||||
(define dict->list custom-hash->list)
|
||||
(define dict-empty? custom-hash-empty?)
|
||||
(define dict-clear custom-hash-clear)])
|
||||
|
||||
(define-values (create-custom-hash
|
||||
create-immutable-custom-hash
|
||||
|
|
@ -592,6 +885,10 @@
|
|||
dict-keys
|
||||
dict-values
|
||||
dict->list
|
||||
dict-clear
|
||||
dict-clear!
|
||||
dict-empty?
|
||||
dict-supports?
|
||||
(rename-out [create-custom-hash make-custom-hash]
|
||||
[create-immutable-custom-hash make-immutable-custom-hash])
|
||||
make-weak-custom-hash
|
||||
|
|
|
|||
|
|
@ -5,33 +5,97 @@
|
|||
(cons (hash-iterate-key h pos)
|
||||
(loop (hash-iterate-next h pos)))
|
||||
null)))
|
||||
|
||||
|
||||
(define (hash-values table)
|
||||
(unless (hash? table)
|
||||
(raise-argument-error 'hash-values "hash?" table))
|
||||
(hash-map table (λ (k v) v)))
|
||||
|
||||
|
||||
(define (hash->list table)
|
||||
(unless (hash? table)
|
||||
(raise-argument-error 'hash->list "hash?" table))
|
||||
(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))
|
||||
|
||||
(define (hash-set* table . pairs0)
|
||||
(unless (and (hash? table) (immutable? table))
|
||||
(raise-argument-error 'hash-set*
|
||||
"(and/c hash? immutable?)"
|
||||
table))
|
||||
(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)))))
|
||||
|
||||
[pairs pairs0])
|
||||
(cond
|
||||
[(null? pairs) table]
|
||||
[(null? (cdr pairs))
|
||||
(raise-arguments-error
|
||||
'hash-set*
|
||||
"expected an even number of association elements, but received an odd number"
|
||||
"association elements"
|
||||
pairs0)]
|
||||
[else (loop (hash-set table (car pairs) (cadr pairs))
|
||||
(cddr pairs))])))
|
||||
|
||||
(define (hash-set*! table . pairs0)
|
||||
(unless (and (hash? table) (not (immutable? table)))
|
||||
(raise-argument-error 'hash-set*!
|
||||
"(and/c hash? (not/c immutable?))"
|
||||
table))
|
||||
(let loop ([pairs pairs0])
|
||||
(cond
|
||||
[(null? pairs) (void)]
|
||||
[(null? (cdr pairs))
|
||||
(raise-arguments-error
|
||||
'hash-set*!
|
||||
"expected an even number of association elements, but received an odd number"
|
||||
"association elements"
|
||||
pairs0)]
|
||||
[else
|
||||
(hash-set! table (car pairs) (cadr pairs))
|
||||
(loop (cddr pairs))])))
|
||||
|
||||
;; 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)
|
||||
(unless (hash? table)
|
||||
(raise-argument-error 'hash-clear "hash?" 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-empty? table)
|
||||
(unless (hash? table)
|
||||
(raise-argument-error 'hash-empty? "hash?" table))
|
||||
(zero? (hash-count table)))
|
||||
|
||||
(provide hash-keys
|
||||
hash-values
|
||||
hash->list
|
||||
hash-set*
|
||||
hash-set*!))
|
||||
hash-set*!
|
||||
hash-empty?
|
||||
hash-clear
|
||||
hash-clear!))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user