From da1fe888a779d25bedf6948b8c0fefe79dfd2d68 Mon Sep 17 00:00:00 2001 From: Carl Eastlund Date: Sun, 21 Jul 2013 16:28:31 -0400 Subject: [PATCH] Added dict-copy operation; renamed dict-supports(?|/c) to dict-implements(?|/c). 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. --- pkgs/data-lib/data/order.rkt | 2 +- racket/collects/racket/dict.rkt | 36 ++++++++------- .../collects/racket/private/custom-hash.rkt | 5 ++ racket/collects/racket/private/dict.rkt | 46 +++++++++++++------ 4 files changed, 56 insertions(+), 33 deletions(-) diff --git a/pkgs/data-lib/data/order.rkt b/pkgs/data-lib/data/order.rkt index c6689899a5..8d233b0b84 100644 --- a/pkgs/data-lib/data/order.rkt +++ b/pkgs/data-lib/data/order.rkt @@ -19,7 +19,7 @@ prop:ordered-dict ordered-methods ordered-dict? - ordered-dict-supports?) + ordered-dict-implements?) #:fast-defaults () #:defaults () #:fallbacks () diff --git a/racket/collects/racket/dict.rkt b/racket/collects/racket/dict.rkt index d55b7913a5..afeee17c2f 100644 --- a/racket/collects/racket/dict.rkt +++ b/racket/collects/racket/dict.rkt @@ -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 diff --git a/racket/collects/racket/private/custom-hash.rkt b/racket/collects/racket/private/custom-hash.rkt index dd4313799c..71db64bc46 100644 --- a/racket/collects/racket/private/custom-hash.rkt +++ b/racket/collects/racket/private/custom-hash.rkt @@ -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) diff --git a/racket/collects/racket/private/dict.rkt b/racket/collects/racket/private/dict.rkt index 64d44d7b94..c6eb9b0102 100644 --- a/racket/collects/racket/private/dict.rkt +++ b/racket/collects/racket/private/dict.rkt @@ -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]