Revert "Fix gen:dict methods for alists with duplicate keys (#2846)"
This breaks existing packages; see https://github.com/greghendershott/aws/issues/64
for an example.
Unfortunately, we probably have to live with this limitation of the
interface because of existing code.
This reverts commit 966399dec6
.
This commit is contained in:
parent
a191f77c15
commit
ce3992dbf3
|
@ -16,30 +16,15 @@
|
|||
(define (dict-count dict)
|
||||
(length (remove-duplicates (alist-v dict) #:key car)))])
|
||||
|
||||
|
||||
(module+ test
|
||||
(require rackunit)
|
||||
|
||||
(define d1 '((1 . a) (2 . b)))
|
||||
(define d2
|
||||
'([a . 1]
|
||||
[a . 2]
|
||||
[a . 3]))
|
||||
|
||||
(check-true (dict? d1))
|
||||
(check-eq? (dict-ref d1 1) 'a)
|
||||
(check-equal? (dict-count (dict-remove d1 2)) 1)
|
||||
(check-false (dict-mutable? d1))
|
||||
(check-true (dict-can-remove-keys? d1))
|
||||
(check-true (dict-can-functional-set? d1))
|
||||
|
||||
(check-eq? (dict-ref d2 'a) 1)
|
||||
(check-equal? (dict-set d2 'a 4) '([a . 4] [a . 2] [a . 3]))
|
||||
(check-equal? (dict-remove d2 'a) '())
|
||||
(check-eq? (dict-count d2) 1)
|
||||
(check-equal? (dict-keys d2) '(a))
|
||||
(check-equal? (dict-values d2) '(1))
|
||||
(check-equal? (dict->list d2) '([a . 1]))
|
||||
(check-equal?
|
||||
(for/list ([{k v} (in-dict d2)])
|
||||
(cons k v))
|
||||
'([a . 1])))
|
||||
(check-true (dict-can-functional-set? d1)))
|
||||
|
|
|
@ -131,7 +131,7 @@
|
|||
[else
|
||||
(let ([a (car xd)])
|
||||
(if (equal? (car a) key)
|
||||
(loop (cdr xd))
|
||||
(cdr xd)
|
||||
(cons a (loop (cdr xd)))))])))
|
||||
|
||||
(define (vector-iterate-first d)
|
||||
|
@ -156,93 +156,17 @@
|
|||
|
||||
(define vector-iterate-value vector-ref)
|
||||
|
||||
(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-fold-unique f init d #:who [who 'assoc-fold-unique])
|
||||
(unless (assoc? d)
|
||||
(raise-argument-error who "dict?" d))
|
||||
(let loop ([xd d]
|
||||
[acc init]
|
||||
[seen (make-immutable-hash)])
|
||||
(cond
|
||||
[(null? xd) acc]
|
||||
[else
|
||||
(let ([a (car xd)])
|
||||
(if (hash-has-key? seen (car a))
|
||||
(loop (cdr xd) acc seen)
|
||||
(loop (cdr xd) (f a acc) (hash-set seen (car a) #t))))])))
|
||||
|
||||
(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-count d)
|
||||
(assoc-fold-unique (lambda (a acc) (+ acc 1)) 0 d #:who dict-count))
|
||||
|
||||
(define (assoc-keys d)
|
||||
(reverse (assoc-fold-unique (lambda (a acc) (cons (car a) acc)) null d #:who 'dict-keys)))
|
||||
|
||||
(define (assoc-values d)
|
||||
(reverse (assoc-fold-unique (lambda (a acc) (cons (cdr a) acc)) null d #:who 'dict-values)))
|
||||
|
||||
(define (assoc->list d)
|
||||
(reverse (assoc-fold-unique cons null d #:who 'dict->list)))
|
||||
|
||||
(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) '())
|
||||
(unless (assoc? d)
|
||||
(raise-argument-error 'dict-count "dict?" d))
|
||||
(length d))
|
||||
|
||||
(struct assoc-iter (head pos))
|
||||
|
||||
(define (assoc-iterate-first d)
|
||||
(unless (assoc? d)
|
||||
(raise-argument-error 'dict-iterate-first "dict?" d))
|
||||
(if (null? d) #f (assoc-iter d (assoc->list d))))
|
||||
(if (null? d) #f (assoc-iter d d)))
|
||||
|
||||
(define (assoc-iterate-next d i)
|
||||
(cond
|
||||
|
@ -281,6 +205,73 @@
|
|||
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 (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-implements? d 'dict-remove)
|
||||
(raise-support-error 'dict-clear d))
|
||||
|
@ -415,7 +406,7 @@
|
|||
(define dict-for-each assoc-for-each)
|
||||
(define dict-keys assoc-keys)
|
||||
(define dict-values assoc-values)
|
||||
(define dict->list assoc->list)
|
||||
(define dict->list values)
|
||||
(define dict-empty? null?)
|
||||
(define dict-clear assoc-clear)])
|
||||
#:defaults ()
|
||||
|
|
Loading…
Reference in New Issue
Block a user