From ce3992dbf33a01688f849d3adb2d53b0d8ebbfe6 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@indiana.edu>
Date: Sat, 9 Nov 2019 22:05:53 -0500
Subject: [PATCH] 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 966399dec6782ab22641162abf6a528597e352a7.
---
 pkgs/racket-test/tests/generic/alist.rkt |  19 +--
 racket/collects/racket/private/dict.rkt  | 155 +++++++++++------------
 2 files changed, 75 insertions(+), 99 deletions(-)

diff --git a/pkgs/racket-test/tests/generic/alist.rkt b/pkgs/racket-test/tests/generic/alist.rkt
index 50747e97aa..070e63bff2 100644
--- a/pkgs/racket-test/tests/generic/alist.rkt
+++ b/pkgs/racket-test/tests/generic/alist.rkt
@@ -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)))
diff --git a/racket/collects/racket/private/dict.rkt b/racket/collects/racket/private/dict.rkt
index 99c18832ab..5e1b9a4423 100644
--- a/racket/collects/racket/private/dict.rkt
+++ b/racket/collects/racket/private/dict.rkt
@@ -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 ()