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

Added dict-copy operation; renamed dict-supports(?|/c) to dict-implements(?|/c).

Browse Source 
Similar to hash-copy or string-copy, dict-copy creates a new, mutable copy of
the given dictionary.  Added as a method of gen:dict.
This commit is contained in:
Carl Eastlund 2013-07-21 16:28:31 -04:00
parent 5c1728dce4
commit da1fe888a7
4 changed files with 56 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/data-lib/data/order.rkt
View File

@ -19,7 +19,7 @@
prop:ordered-dict
ordered-methods
ordered-dict?
ordered-dict-supports?)
ordered-dict-implements?)
#:fast-defaults ()
#:defaults ()
#:fallbacks ()

36
racket/collects/racket/dict.rkt
View File

@ -3,15 +3,15 @@
"private/dict.rkt"
"private/custom-hash.rkt")
(define (dict-supports/c . syms)
(define (dict-implements/c . syms)
(if (null? syms)
dict?
(flat-named-contract
`(dict-supports/c . ,syms)
`(dict-implements/c . ,syms)
(lambda (x)
(and (dict? x)
(for/and ([sym (in-list syms)])
(dict-supports? x sym)))))))
(dict-implements? x sym)))))))
(define dict-method-name/c
(or/c 'dict-ref
@ -35,6 +35,7 @@
'dict-keys
'dict-values
'dict->list
'dict-copy
'dict-empty?
'dict-clear
'dict-clear!))
@ -105,21 +106,21 @@
([default any/c])
any)) ;; because default can be multi-valued procedure
(define dict-set!-contract
(->i ([d (dict-supports/c 'dict-set!)]
(->i ([d (dict-implements/c 'dict-set!)]
[k (d) (dict-key-contract d)]
[value (d) (dict-value-contract d)])
[_r void?]))
(define dict-set-contract
(->i ([d (dict-supports/c 'dict-set)]
(->i ([d (dict-implements/c 'dict-set)]
[k (d) (dict-key-contract d)]
[value (d) (dict-value-contract d)])
[_r dict?]))
(define dict-remove!-contract
(->i ([d (dict-supports/c 'dict-remove!)]
(->i ([d (dict-implements/c 'dict-remove!)]
[k (d) (dict-key-contract d)])
[_r void?]))
(define dict-remove-contract
(->i ([d (dict-supports/c 'dict-remove)]
(->i ([d (dict-implements/c 'dict-remove)]
[k (d) (dict-key-contract d)])
[_r dict?]))
(define dict-count-contract
@ -180,7 +181,7 @@
[dict-ref
dict-ref-contract]
[dict-ref!
(->i ([d (dict-supports/c 'dict-set!)]
(->i ([d (dict-implements/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)])]
@ -189,7 +190,7 @@
[dict-set
dict-set-contract]
[dict-set*!
(->i ([d (dict-supports/c 'dict-set!)])
(->i ([d (dict-implements/c 'dict-set!)])
#:rest [rst (d) (let ([key/c (dict-key-contract d)]
[val/c (dict-value-contract d)])
(letrec ([args/c
@ -200,7 +201,7 @@
args/c)))]
[_r void?])]
[dict-set*
(->i ([d (dict-supports/c 'dict-set)])
(->i ([d (dict-implements/c 'dict-set)])
#:rest [rst (d) (let ([key/c (dict-key-contract d)]
[val/c (dict-value-contract d)])
(letrec ([args/c
@ -211,13 +212,13 @@
args/c)))]
[_r dict?])]
[dict-update!
(->i ([d (dict-supports/c 'dict-set!)]
(->i ([d (dict-implements/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 (dict-supports/c 'dict-set)]
(->i ([d (dict-implements/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 ?
@ -255,20 +256,21 @@
[_r (d) (listof (cons/c (dict-key-contract d) (dict-value-contract d)))])]
[dict-empty? (-> dict? boolean?)]
[dict-copy (-> dict? dict?)]
[dict-clear
(->i ([d dict?])
[_r (d) (apply dict-supports/c
[_r (d) (apply dict-implements/c
(for/list ([sym (in-list '(dict-set dict-set!))]
#:when (dict-supports? d sym))
#:when (dict-implements? d sym))
sym))])]
[dict-clear!
(->i ([d (dict-supports/c 'dict-remove!)])
(->i ([d (dict-implements/c 'dict-remove!)])
[_r void?]
#:post (d) (dict-empty? d))]
[dict-supports?
[dict-implements?
(->* [dict?] [] #:rest (listof dict-method-name/c) boolean?)]
[dict-supports/c
[dict-implements/c
(->* [] [] #:rest (listof dict-method-name/c) flat-contract?)])
(provide gen:dict

5
racket/collects/racket/private/custom-hash.rkt
View File

@ -138,6 +138,10 @@
(for/fold ([vals '()]) ([v (in-hash-values (custom-hash-table d))])
(cons v vals)))
(define (custom-hash-copy d)
(dprintf "custom-hash-copy\n")
(update-custom-hash-table d (hash-copy (custom-hash-table d))))
(define (custom-hash->list d)
(dprintf "custom-hash->list\n")
(for/fold ([pairs '()]) ([(k v) (in-hash (custom-hash-table d))])
@ -251,6 +255,7 @@
(define dict-for-each custom-hash-for-each)
(define dict-keys custom-hash-keys)
(define dict-values custom-hash-values)
(define dict-copy custom-hash-copy)
(define dict->list custom-hash->list)
(define dict-empty? custom-hash-empty?)
(define dict-clear custom-hash-clear)

46
racket/collects/racket/private/dict.rkt
View File

@ -2,6 +2,7 @@
(require racket/private/generic ; to avoid circular dependencies
racket/private/generic-methods
racket/vector
(only-in racket/private/hash paired-fold)
(for-syntax racket/base))
@ -23,18 +24,18 @@
(define (dict-mutable? d)
(unless (dict? d)
(raise-argument-error 'dict-mutable? "dict?" d))
(dict-supports? d 'dict-set!))
(dict-implements? d 'dict-set!))
(define (dict-can-remove-keys? d)
(unless (dict? d)
(raise-argument-error 'dict-can-remove-keys? "dict?" d))
(or (dict-supports? d 'dict-remove!)
(dict-supports? d 'dict-remove)))
(or (dict-implements? d 'dict-remove!)
(dict-implements? d 'dict-remove)))
(define (dict-can-functional-set? d)
(unless (dict? d)
(raise-argument-error 'dict-can-functional-set? "dict?" d))
(dict-supports? d 'dict-set))
(dict-implements? d 'dict-set))
(define (fallback-has-key? d k)
(define not-there (gensym))
@ -65,7 +66,7 @@
[else default]))
(define (fallback-ref! d key new)
(unless (dict-supports? d 'dict-set!)
(unless (dict-implements? d 'dict-set!)
(raise-support-error 'dict-ref! d))
(define not-there (gensym))
(define v (dict-ref d key not-there))
@ -88,36 +89,36 @@
(cons a (loop (cdr xd)))))])))
(define (fallback-set*! d . pairs)
(unless (dict-supports? d 'dict-set!)
(unless (dict-implements? d 'dict-set!)
(raise-support-error 'dict-set*! d))
(paired-fold 'dict-set*! pairs (void)
(lambda (x k v)
(dict-set! d k v))))
(define (fallback-set* d . pairs)
(unless (dict-supports? d 'dict-set)
(unless (dict-implements? d 'dict-set)
(raise-support-error 'dict-set* d))
(paired-fold 'dict-set* pairs d dict-set))
(define fallback-update!
(case-lambda
[(d key xform)
(unless (dict-supports? d 'dict-set!)
(unless (dict-implements? d 'dict-set!)
(raise-support-error 'dict-update! d))
(dict-set! d key (xform (dict-ref d key)))]
[(d key xform default)
(unless (dict-supports? d 'dict-set!)
(unless (dict-implements? d 'dict-set!)
(raise-support-error 'dict-update! d))
(dict-set! d key (xform (dict-ref d key default)))]))
(define fallback-update
(case-lambda
[(d key xform)
(unless (dict-supports? d 'dict-set)
(unless (dict-implements? d 'dict-set)
(raise-support-error 'dict-update d))
(dict-set d key (xform (dict-ref d key)))]
[(d key xform default)
(unless (dict-supports? d 'dict-set)
(unless (dict-implements? d 'dict-set)
(raise-support-error 'dict-update d))
(dict-set d key (xform (dict-ref d key default)))]))
@ -261,16 +262,24 @@
(raise-argument-error 'dict-values "dict?" d))
(cdr x)))
(define (fallback-copy d)
(unless (dict-implements? d 'dict-clear dict-set!)
(raise-support-error 'dict-copy d))
(define d2 (dict-clear d))
(for ([(k v) (in-dict d)])
(dict-set! d2 k v))
d2)
(define (assoc-clear d) '())
(define (fallback-clear d)
(unless (dict-supports? d 'dict-remove)
(unless (dict-implements? d 'dict-remove)
(raise-support-error 'dict-clear d))
(for/fold ([d d]) ([k (in-dict-keys d)])
(dict-remove d k)))
(define (fallback-clear! d)
(unless (dict-supports? d 'dict-remove!)
(unless (dict-implements? d 'dict-remove!)
(raise-support-error 'dict-clear! d))
(let loop ()
(define i (dict-iterate-first d))
@ -311,7 +320,7 @@
(raise-mismatch-error name "not implemented for " s))
(define-primitive-generics
(dict gen:dict prop:gen:dict prop:gen:dict-methods dict? dict-supports?)
(dict gen:dict prop:gen:dict prop:gen:dict-methods dict? dict-implements?)
#:fast-defaults
([mutable-hash? mutable-hash?
(define dict-ref hash-ref)
@ -331,6 +340,7 @@
(define dict-keys hash-keys)
(define dict-values hash-values)
(define dict->list hash->list)
(define dict-copy hash-copy)
(define dict-empty? hash-empty?)
(define dict-clear hash-clear)
(define dict-clear! hash-clear!)]
@ -350,6 +360,7 @@
(define dict-for-each hash-for-each)
(define dict-keys hash-keys)
(define dict-values hash-values)
(define dict-copy hash-copy)
(define dict->list hash->list)
(define dict-empty? hash-empty?)
(define dict-clear hash-clear)]
@ -366,6 +377,7 @@
(define dict-for-each vector-for-each)
(define dict-keys vector-keys)
(define dict-values vector->list)
(define dict-copy vector-copy)
(define dict->list vector->assoc)
(define dict-empty? vector-empty?)]
[immutable-vector? immutable-vector?
@ -380,6 +392,7 @@
(define dict-for-each vector-for-each)
(define dict-keys vector-keys)
(define dict-values vector->list)
(define dict-copy vector-copy)
(define dict->list vector->assoc)
(define dict-empty? vector-empty?)]
[assoc? list?
@ -413,6 +426,7 @@
(define dict-keys fallback-keys)
(define dict-values fallback-values)
(define dict->list fallback->list)
(define dict-copy fallback-copy)
(define dict-empty? fallback-empty?)
(define dict-clear fallback-clear)
(define dict-clear! fallback-clear!)]
@ -438,6 +452,7 @@
(dict-keys dict)
(dict-values dict)
(dict->list dict)
(dict-copy dict)
(dict-empty? dict)
(dict-clear dict)
(dict-clear! dict))
@ -622,10 +637,11 @@
dict-keys
dict-values
dict->list
dict-copy
dict-clear
dict-clear!
dict-empty?
dict-supports?
dict-implements?
(rename-out [:in-dict in-dict]
[:in-dict-keys in-dict-keys]