From a68242e4eb0ad371f9dabb54c3b0add86e1c1ca0 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 9 May 2012 17:24:43 -0400
Subject: [PATCH] Implement ordered dicts in terms of generics.

---
 collects/data/order.rkt               | 47 +++++++++++----------------
 collects/data/scribblings/order.scrbl | 21 +++++++-----
 collects/data/skip-list.rkt           | 36 +++++++++++++-------
 collects/data/splay-tree.rkt          | 25 ++++++++------
 4 files changed, 72 insertions(+), 57 deletions(-)

diff --git a/collects/data/order.rkt b/collects/data/order.rkt
index de13da99e9..d833513709 100644
--- a/collects/data/order.rkt
+++ b/collects/data/order.rkt
@@ -2,15 +2,21 @@
 (require racket/dict
          racket/contract/base
          racket/string
-         ffi/unsafe/atomic)
+         ffi/unsafe/atomic
+         generics)
 
 (define ordering/c
   (or/c '= '< '>))
 
 (provide ordering/c)
 
-(define-values (prop:ordered-dict ordered-dict? ordered-dict-ref)
-  (make-struct-type-property 'ordered-dict #f))
+(define-generics (ordered-dict prop:ordered-dict ordered-dict?)
+  (dict-iterate-least ordered-dict)
+  (dict-iterate-greatest ordered-dict)
+  (dict-iterate-least/>? ordered-dict key)
+  (dict-iterate-least/>=? ordered-dict key)
+  (dict-iterate-greatest/<? ordered-dict key)
+  (dict-iterate-greatest/<=? ordered-dict key))
 
 (define extreme-contract
   (->i ([d ordered-dict?])
@@ -22,34 +28,19 @@
        [_r (d) (or/c #f (dict-iter-contract d))]))
 
 (define prop:ordered-dict-contract
-  (let ([e extreme-contract]
-        [s search-contract])
-    (vector-immutable/c e   ;; iterate-least
-                        e   ;; iterate-greatest
-                        s   ;; iterate-least/>?
-                        s   ;; iterate-least/>=?
-                        s   ;; iterate-greatest/<?
-                        s)));; iterate-greatest/<=?
+  (let ([e (or/c extreme-contract #f)] ;; generics initializes with #f,
+                                        ; then sets the methods
+        [s (or/c search-contract #f)])
+    (vector/c e   ;; iterate-least
+              e   ;; iterate-greatest
+              s   ;; iterate-least/>?
+              s   ;; iterate-least/>=?
+              s   ;; iterate-greatest/<?
+              s)));; iterate-greatest/<=?
 
 ;; --------
 
-(define-syntax-rule (appd d offset arg ...)
-  (let ([dv d])
-    ((vector-ref (ordered-dict-ref dv) offset) dv arg ...)))
-
-(define (dict-iterate-least d)
-  (appd d 0))
-(define (dict-iterate-greatest d)
-  (appd d 1))
-(define (dict-iterate-least/>? d k)
-  (appd d 2 k))
-(define (dict-iterate-least/>=? d k)
-  (appd d 3 k))
-(define (dict-iterate-greatest/<? d k)
-  (appd d 4 k))
-(define (dict-iterate-greatest/<=? d k)
-  (appd d 5 k))
-
+(provide ordered-dict)
 (provide/contract
  [prop:ordered-dict
   (struct-type-property/c prop:ordered-dict-contract)]
diff --git a/collects/data/scribblings/order.scrbl b/collects/data/scribblings/order.scrbl
index 667dea1bb6..9b8a535430 100644
--- a/collects/data/scribblings/order.scrbl
+++ b/collects/data/scribblings/order.scrbl
@@ -3,7 +3,8 @@
           (for-label data/order
                      racket/contract
                      racket/dict
-                     racket/base))
+                     racket/base
+		     generics))
 
 @title{Orders and Ordered Dictionaries}
 
@@ -23,15 +24,19 @@ Contract for orderings, represented by the symbols @racket['=],
 @racket['<], and @racket['>].
 }
 
+@deftogether[[
+@defthing[ordered-dict any/c]
 @defthing[prop:ordered-dict
           (struct-type-property/c
-           (vector-immutableof _e/c _e/c _s/c _s/c _s/c _s/c))]{
+           (vectorof _e/c _e/c _s/c _s/c _s/c _s/c))]
+]]{
 
-Struct-type property for defining new ordered dictionary types. The
-value associated with @racket[prop:ordered-dict] should be an
-immutable vector of six procedures, two ``extrema'' procedures and
-four ``search'' procedures. The extrema procedures must satisfy
-@racket[_e/c] and the search procedures must satisfy @racket[_s/c]:
+Struct-type property for defining new ordered dictionary types.
+Methods can be attached to the @racket[prop:ordered-dict] struct property
+using the @racket[methods] form and the @racket[ordered-dict] generic
+interface. Two ``extrema'' methods and four ``search'' methods should be
+implemented. The extrema methods must satisfy @racket[_e/c] and the search
+methods must satisfy @racket[_s/c]:
 
 @racketblock[
 _e/c = (->i ([d ordered-dict?])
@@ -41,7 +46,7 @@ _s/c = (->i ([d ordered-dict?]
             [_ (d) (or/c #f (dict-iter-contract d))])
 ]
 
-The procedures are implementations of the following generic functions:
+The methods are implementations of the following generic functions:
 
 @itemize[
 @item{@racket[dict-iterate-least]}
diff --git a/collects/data/skip-list.rkt b/collects/data/skip-list.rkt
index 16e98f6561..97efbcea50 100644
--- a/collects/data/skip-list.rkt
+++ b/collects/data/skip-list.rkt
@@ -2,6 +2,7 @@
 (require racket/match
          racket/contract/base
          racket/dict
+         generics
          "order.rkt")
 ;; owned by ryanc
 
@@ -350,20 +351,19 @@ Levels are indexed starting at 1, as in the paper.
                     skip-list-iterate-key
                     skip-list-iterate-value))
 
-(define ordered-dict-methods
-  (vector-immutable skip-list-iterate-least
-                    skip-list-iterate-greatest
-                    skip-list-iterate-least/>?
-                    skip-list-iterate-least/>=?
-                    skip-list-iterate-greatest/<?
-                    skip-list-iterate-greatest/<=?))
-
 (struct skip-list ([head #:mutable] [num-entries #:mutable] =? <?)
         #:property prop:dict/contract
         (list dict-methods
               (vector-immutable any/c any/c skip-list-iter?
                                 #f #f #f))
-        #:property prop:ordered-dict ordered-dict-methods)
+        #:property prop:ordered-dict
+        (methods ordered-dict
+          (define dict-iterate-least skip-list-iterate-least)
+          (define dict-iterate-greatest skip-list-iterate-greatest)
+          (define dict-iterate-least/>? skip-list-iterate-least/>?)
+          (define dict-iterate-least/>=? skip-list-iterate-least/>=?)
+          (define dict-iterate-greatest/<? skip-list-iterate-greatest/<?)
+          (define dict-iterate-greatest/<=? skip-list-iterate-greatest/<=?)))
 
 (struct skip-list* skip-list (key-c value-c)
         #:property prop:dict/contract
@@ -372,7 +372,14 @@ Levels are indexed starting at 1, as in the paper.
                                 (lambda (s) (skip-list*-key-c s))
                                 (lambda (s) (skip-list*-value-c s))
                                 #f))
-        #:property prop:ordered-dict ordered-dict-methods)
+        #:property prop:ordered-dict
+        (methods ordered-dict
+          (define dict-iterate-least skip-list-iterate-least)
+          (define dict-iterate-greatest skip-list-iterate-greatest)
+          (define dict-iterate-least/>? skip-list-iterate-least/>?)
+          (define dict-iterate-least/>=? skip-list-iterate-least/>=?)
+          (define dict-iterate-greatest/<? skip-list-iterate-greatest/<?)
+          (define dict-iterate-greatest/<=? skip-list-iterate-greatest/<=?)))
 
 (struct adjustable-skip-list skip-list ()
         #:property prop:dict/contract
@@ -387,7 +394,14 @@ Levels are indexed starting at 1, as in the paper.
                                 (lambda (s) (adjustable-skip-list*-key-c s))
                                 (lambda (s) (adjustable-skip-list*-value-c s))
                                 #f))
-        #:property prop:ordered-dict ordered-dict-methods)
+        #:property prop:ordered-dict
+        (methods ordered-dict
+          (define dict-iterate-least skip-list-iterate-least)
+          (define dict-iterate-greatest skip-list-iterate-greatest)
+          (define dict-iterate-least/>? skip-list-iterate-least/>?)
+          (define dict-iterate-least/>=? skip-list-iterate-least/>=?)
+          (define dict-iterate-greatest/<? skip-list-iterate-greatest/<?)
+          (define dict-iterate-greatest/<=? skip-list-iterate-greatest/<=?)))
 
 (define (make-skip-list [ord datum-order]
                         #:key-contract [key-contract any/c]
diff --git a/collects/data/splay-tree.rkt b/collects/data/splay-tree.rkt
index 4384603161..f93599b64f 100644
--- a/collects/data/splay-tree.rkt
+++ b/collects/data/splay-tree.rkt
@@ -4,6 +4,7 @@
          racket/match
          racket/dict
          racket/contract/base
+	 generics
          "order.rkt")
 
 #|
@@ -514,14 +515,6 @@ Options
                     n:splay-tree-iterate-key
                     n:splay-tree-iterate-value))
 
-(define n:ordered-dict-methods
-  (vector-immutable n:splay-tree-iterate-least
-                    n:splay-tree-iterate-greatest
-                    n:splay-tree-iterate-least/>?
-                    n:splay-tree-iterate-least/>=?
-                    n:splay-tree-iterate-greatest/<?
-                    n:splay-tree-iterate-greatest/<=?))
-
 (struct node-splay-tree ([root #:mutable] [size #:mutable])
         #:property prop:dict/contract
         (list n:dict-methods
@@ -530,7 +523,13 @@ Options
                                 splay-tree-iter?
                                 #f #f #f))
         #:property prop:ordered-dict
-        n:ordered-dict-methods)
+	(methods ordered-dict
+	  (define dict-iterate-least n:splay-tree-iterate-least)
+	  (define dict-iterate-greatest n:splay-tree-iterate-greatest)
+	  (define dict-iterate-least/>? n:splay-tree-iterate-least/>?)
+	  (define dict-iterate-least/>=? n:splay-tree-iterate-least/>=?)
+	  (define dict-iterate-greatest/<? n:splay-tree-iterate-greatest/<?)
+	  (define dict-iterate-greatest/<=? n:splay-tree-iterate-greatest/<=?)))
 
 (struct node-splay-tree* node-splay-tree (key-c value-c)
         #:property prop:dict/contract
@@ -542,7 +541,13 @@ Options
                                 (lambda (s) (node-splay-tree*-value-c s))
                                 #f))
         #:property prop:ordered-dict
-        n:ordered-dict-methods)
+        (methods ordered-dict
+	  (define dict-iterate-least n:splay-tree-iterate-least)
+	  (define dict-iterate-greatest n:splay-tree-iterate-greatest)
+	  (define dict-iterate-least/>? n:splay-tree-iterate-least/>?)
+	  (define dict-iterate-least/>=? n:splay-tree-iterate-least/>=?)
+	  (define dict-iterate-greatest/<? n:splay-tree-iterate-greatest/<?)
+	  (define dict-iterate-greatest/<=? n:splay-tree-iterate-greatest/<=?)))