added data/order, docs

changed splay-tree, skip-list constructors to take orders

collects/data/interval-map.rkt

@@ -100,10 +100,10 @@
 
 (define (norm s pos adjust)
   (cond [(= pos -inf.0)
-         (let ([iter (splay-tree-iterate-min s)])
+         (let ([iter (splay-tree-iterate-least s)])
            (and iter (splay-tree-iterate-key s iter)))]
         [(= pos +inf.0)
-         (let ([iter (splay-tree-iterate-max s)])
+         (let ([iter (splay-tree-iterate-greatest s)])
            ;; add 1 to *include* max (recall, half-open intervals)
            (and iter (+ 1 (splay-tree-iterate-key s iter))))]
         [else pos]))

collects/data/order.rkt

@@ -4,6 +4,11 @@
          racket/string
          unstable/prop-contract)
 
+(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))
 
@@ -19,8 +24,8 @@
 (define prop:ordered-dict-contract
   (let ([e extreme-contract]
         [s search-contract])
-    (vector-immutable/c e   ;; iterate-min
+    (vector-immutable/c e   ;; iterate-least
-                        e   ;; iterate-max
+                        e   ;; iterate-greatest
                         s   ;; iterate-least/>?
                         s   ;; iterate-least/>=?
                         s   ;; iterate-greatest/<?
@@ -32,9 +37,9 @@
   (let ([dv d])
     ((vector-ref (ordered-dict-ref dv) offset) dv arg ...)))
 
-(define (dict-iterate-min d)
+(define (dict-iterate-least d)
   (appd d 0))
-(define (dict-iterate-max d)
+(define (dict-iterate-greatest d)
   (appd d 1))
 (define (dict-iterate-least/>? d k)
   (appd d 2 k))
@@ -49,8 +54,8 @@
  [prop:ordered-dict
   (struct-type-property/c prop:ordered-dict-contract)]
  [ordered-dict? (-> any/c boolean?)]
- [dict-iterate-min extreme-contract]
+ [dict-iterate-least extreme-contract]
- [dict-iterate-max extreme-contract]
+ [dict-iterate-greatest extreme-contract]
  [dict-iterate-least/>? search-contract]
  [dict-iterate-least/>=? search-contract]
  [dict-iterate-greatest/<? search-contract]
@@ -58,10 +63,62 @@
 
 ;; ============================================================
 
-(provide natural-cmp
+(struct order (name domain-contract comparator =? <?)
-         datum-cmp)
+        #:property prop:procedure (struct-field-index comparator))
 
-;; Comparator : any any -> (U '< '= '>)
+(define order*
+  (let ([order
+         (case-lambda
+           [(name ctc cmp)
+            (order name ctc cmp
+                   (lambda (x y) (eq? (cmp x y) '=))
+                   (lambda (x y) (eq? (cmp x y) '<)))]
+           [(name ctc = <)
+            (order name ctc
+                   (lambda (x y)
+                     (cond [(= x y) '=]
+                           [(< x y) '<]
+                           [(< y x) '>]
+                           [else (incomparable name x y)]))
+                   = <)]
+           [(name ctc = < >)
+            (order name ctc
+                   (lambda (x y)
+                     (cond [(= x y) '=]
+                           [(< x y) '<]
+                           [(> x y) '>]
+                           [else (incomparable name x y)]))
+                   = <)])])
+    order))
+
+(define (incomparable name x y)
+  (error name "values are incomparable: ~e ~e" x y))
+
+(provide/contract
+ [rename order* order
+  (->* (symbol? contract? procedure?) (procedure? procedure?)
+       order?)]
+ [order? (-> any/c boolean?)]
+ [order-comparator
+  (-> order? procedure?)]
+ [order-<?
+  (-> order? procedure?)]
+ [order-=?
+  (-> order? procedure?)]
+ [order-domain-contract
+  (-> order? contract?)])
+
+;; ============================================================
+
+(define (real/not-NaN? x) (and (real? x) (not (eqv? x +nan.0))))
+
+(define real-order
+  (order* 'real-order real/not-NaN? = < >))
+
+(provide/contract
+ [real-order order?])
+
+;; ============================================================
 
 #|
 natural-cmp : Comparator
@@ -103,6 +160,8 @@ Other:
 
 |#
 
+;; not exported because I'm not sure it's a good idea and I'm not sure
+;; how to characterize it
 (define (natural-cmp x y)
   (gen-cmp x y #t))
 
@@ -239,3 +298,9 @@ Other:
         [(< i (vector-length y))
          '<]
         [else '=]))
+
+(define datum-order
+  (order* 'datum-order any/c datum-cmp))
+
+(provide/contract
+ [datum-order order?])

collects/data/scribblings/data.scrbl

@@ -17,6 +17,7 @@ This manual documents data structure libraries available in the
 
 @include-section["queue.scrbl"]
 @include-section["gvector.scrbl"]
+@include-section["order.scrbl"]
 @include-section["splay-tree.scrbl"]
 @include-section["skip-list.scrbl"]
 @include-section["interval-map.scrbl"]

collects/data/scribblings/order.scrbl

@@ -0,0 +1,201 @@
+#lang scribble/manual
+@(require scribble/eval
+          (for-label data/order
+                     racket/contract
+                     unstable/prop-contract
+                     racket/dict
+                     racket/base))
+
+@title{Orders and Ordered Dictionaries}
+
+@(define the-eval (make-base-eval))
+@(the-eval '(require racket/dict data/order))
+
+@defmodule[data/order]
+
+@author[@author+email["Ryan Culpepper" "ryanc@racket-lang.org"]]
+
+This library defines @deftech{orders} and the @deftech{ordered
+dictionary} generic interface.
+
+@defthing[ordering/c flat-contract?]{
+
+Contract for orderings, represented by the symbols @racket['=],
+@racket['<], and @racket['>].
+}
+
+@defthing[prop:ordered-dict
+          (struct-type-property/c
+           (vector-immutableof _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]:
+
+@racketblock[
+_e/c = (->i ([d ordered-dict?])
+            [_ (d) (or/c #f (dict-iter-contract d))])
+_s/c = (->i ([d ordered-dict?]
+             [k (d) (dict-key-contract d)])
+            [_ (d) (or/c #f (dict-iter-contract d))])
+]
+
+The procedures are implementations of the following generic functions:
+
+@itemize[
+@item{@racket[dict-iterate-least]}
+@item{@racket[dict-iterate-greatest]}
+@item{@racket[dict-iterate-least/>?]}
+@item{@racket[dict-iterate-least/>=?]}
+@item{@racket[dict-iterate-greatest/<?]}
+@item{@racket[dict-iterate-greatest/<=?]}
+]
+
+A struct type that implements @racket[prop:ordered-dict] must also
+implement @racket[prop:dict].
+}
+
+@defproc[(ordered-dict? [x any/c]) boolean?]{
+
+Returns @racket[#t] if @racket[x] is an instance of a struct
+implementing the @tech{ordered dictionary} interface (via
+@racket[prop:ordered-dict]).
+}
+
+@deftogether[[
+@defproc[(dict-iterate-least [dict ordered-dict?]) any/c]
+@defproc[(dict-iterate-greatest [dict ordered-dict?]) any/c]]]{
+
+Returns the position of the least (greatest) key in the ordered
+dictionary @racket[dict]. If @racket[dict] is empty, @racket[#f] is
+returned.
+}
+
+@deftogether[[
+@defproc[(dict-iterate-least/>? [dict ordered-dict?] [key any/c]) any/c]
+@defproc[(dict-iterate-least/>=? [dict ordered-dict?] [key any/c]) any/c]
+@defproc[(dict-iterate-greatest/<? [dict ordered-dict?] [key any/c]) any/c]
+@defproc[(dict-iterate-greatest/<=? [dict ordered-dict?] [key any/c]) any/c]
+]]{
+
+Returns the position of the least key greater than @racket[key], the
+least key greater than or equal to @racket[key], the greatest key less
+than @racket[key], and the greatest key less than or equal to
+@racket[key], respectively. If no key satisfies the criterion,
+@racket[#f] is returned.
+}
+
+@defproc*[([(order [name symbol?] 
+                   [domain-contract contract?]
+                   [comparator (-> any/c any/c ordering/c)])
+            (and/c order? procedure?)]
+           [(order [name symbol?]
+                   [domain-contract contract?]
+                   [=? (-> any/c any/c boolean?)]
+                   [<? (-> any/c any/c boolean?)]
+                   [>? (-> any/c any/c boolean?)
+                       (lambda (x y) (<? y x))])
+            (and/c order? procedure?)])]{
+
+Produces a named order object encapsulating a domain contract and a
+comparator function. If a single procedure is given, it is used
+directly as the comparator. If two or three procedures are given, they
+are used to construct the comparator.
+
+The @racket[domain-contract] is not applied to the comparison
+function; rather, clients of the order are advised to incorporate the
+domain contracts into their own contracts. For example, when a
+splay-tree (see @racketmodname[data/splay-tree]) is constructed with
+an order, it applies the domain-contract to its keys. Thus the
+contract is checked once per dictionary procedure call, rather than on
+every comparison.
+
+An order object is applicable as a procedure; it behaves as its
+comparator.
+
+@examples[#:eval the-eval
+(define string-order (order 'string-order string? string=? string<?))
+(string-order "abc" "acdc")
+(string-order "x" 12)
+]
+}
+
+@defproc[(order? [x any/c]) boolean?]{
+
+Returns @racket[#t] if @racket[x] is an order object, @racket[#f]
+otherwise.
+}
+
+@defproc[(order-comparator [ord order?])
+         (-> any/c any/c ordering/c)]{
+
+Extracts the comparator function from an order object.
+}
+
+@defproc[(order-domain-contract [ord order?]) contract?]{
+
+Extracts the domain contract from an order object.
+}
+
+@deftogether[[
+@defproc[(order-=? [ord order?]) (-> any/c any/c boolean?)]
+@defproc[(order-<? [ord order?]) (-> any/c any/c boolean?)]
+]]{
+
+Returns a procedure representing the order's equality relation or
+less-than relation, respectively.
+}
+
+@defthing[real-order order?]{
+
+The order of the real numbers. The domain of @racket[real-order]
+excludes @racket[+nan.0] but includes @racket[+inf.0] and
+@racket[-inf.0]. The standard numeric comparisons (@racket[=],
+@racket[<]) are used; exact @racket[1] is equal to inexact
+@racket[1.0].
+
+@examples[#:eval the-eval
+(real-order 1.0 1)
+(real-order 5 7)
+(real-order 9.0 3.4)
+(real-order 1 +inf.0)
+(real-order 5 -inf.0)
+]
+}
+
+@defthing[datum-order order?]{
+
+An ad hoc order that encompasses many built-in Racket data types. The
+@racket[datum-order] comparator orders values of the same data type
+according to the data type's natural order: @racket[string=?],
+@racket[string<?] for strings, for example (but see the warning about
+numbers below). Different data types are ordered arbitrarily but
+contiguously; for example, all strings sort before all vectors, or
+vice versa. Programs should not rely on the ordering of different data
+types.
+
+The order is designed so that lists, vectors, and prefab structs are
+ordered lexicographically.
+
+@bold{Warning!} The @racket[datum-order] is not compatible with the
+standard numeric order; all exact numbers are ordered before all
+inexact numbers. This allows @racket[1] to be considered distinct from
+@racket[1.0], for example.
+
+The following built-in data types are currently supported: numbers,
+strings, bytes, keywords, symbols, booleans, characters, null, pairs,
+vectors, boxes, and prefab structs.
+
+@examples[#:eval the-eval
+(datum-order 1 2)
+(datum-order 8 5.0)
+(datum-order 3+5i 3+2i)
+(datum-order '(a #:b c) '(a #:c d c))
+(datum-order "apricot" "apple")
+(datum-order '#(1 2 3) '#(1 2))
+(datum-order '#(1 2 3) '#(1 3))
+(datum-order 'apple (box "candy"))
+]
+}

collects/data/scribblings/skip-list.scrbl

@@ -1,6 +1,7 @@
 #lang scribble/manual
 @(require scribble/eval
           (for-label data/skip-list
+                     data/order
                      racket/contract
                      racket/dict
                      racket/base))
@@ -8,8 +9,7 @@
 @title[#:tag "skip-list"]{Skip Lists}
 
 @(define the-eval (make-base-eval))
-@(the-eval '(require data/skip-list))
+@(the-eval '(require racket/dict data/order data/skip-list))
-@(the-eval '(require racket/dict))
 
 @defmodule[data/skip-list]
 
@@ -20,21 +20,21 @@ dictionaries with totally ordered keys. They were described in the
 paper ``Skip Lists: A Probabilistic Alternative to Balanced Trees'' by
 William Pugh in Communications of the ACM, June 1990, 33(6) pp668-676.
 
-A skip-list is a dictionary (@racket[dict?] from
+A skip-list is an ordered dictionary (@racket[dict?] and
-@racketmodname[racket/dict]). It also supports extensions of the
+@racket[ordered-dict?]). It also supports extensions of the dictionary
-dictionary interface for iterator-based search and mutation.
+interface for iterator-based search and mutation.
 
-@defproc[(make-skip-list [=? (any/c any/c . -> . any/c)]
+@defproc[(make-skip-list [ord order? datum-order]
-                         [<? (any/c any/c . -> . any/c)]
                          [#:key-contract key-contract contract? any/c]
                          [#:value-contract value-contract contract? any/c])
          skip-list?]{
 
-Makes a new empty skip-list. The skip-list uses @racket[=?] and
+Makes a new empty skip-list. The skip-list uses @racket[ord] to order
-@racket[<?] to order keys.
+keys; in addition, the domain contract of @racket[ord] is combined
+with @racket[key-contract] to check keys.
 
 @examples[#:eval the-eval
-(define skip-list (make-skip-list = <))
+(define skip-list (make-skip-list real-order))
 (skip-list-set! skip-list 3 'apple)
 (skip-list-set! skip-list 6 'cherry)
 (dict-map skip-list list)
@@ -136,23 +136,24 @@ keys greater than or equal to @racket[from].
 }
 
 @deftogether[[
+@defproc[(skip-list-iterate-least/>? [skip-list skip-list?]
+                                        [key any/c])
+         (or/c skip-list-iter? #f)]
+@defproc[(skip-list-iterate-least/>=? [skip-list skip-list?]
+                                        [key any/c])
+         (or/c skip-list-iter? #f)]
 @defproc[(skip-list-iterate-greatest/<? [skip-list skip-list?]
                                         [key any/c])
          (or/c skip-list-iter? #f)]
 @defproc[(skip-list-iterate-greatest/<=? [skip-list skip-list?]
                                         [key any/c])
          (or/c skip-list-iter? #f)]
-@defproc[(skip-list-iterate-least/>? [skip-list skip-list?]
+]]{
-                                        [key any/c])
-         (or/c skip-list-iter? #f)]
-@defproc[(skip-list-iterate-least/>=? [skip-list skip-list?]
-                                        [key any/c])
-         (or/c skip-list-iter? #f)]]]{
 
-Return the position of, respectively, the greatest key less than
+Implementations of @racket[dict-iterate-least],
-@racket[key], the greatest key less than or equal to @racket[key], the
+@racket[dict-iterate-greatest], @racket[dict-iterate-least/>?],
-least key greater than @racket[key], and the least key greater than or
+@racket[dict-iterate-least/>=?], @racket[dict-iterate-greatest/<?],
-equal to @racket[key].
+and @racket[dict-iterate-greatest/<=?], respectively.
 }
 
 @defproc[(skip-list-iter? [v any/c]) boolean?]{

collects/data/scribblings/splay-tree.scrbl

@@ -1,6 +1,7 @@
 #lang scribble/manual
 @(require scribble/eval
           (for-label data/splay-tree
+                     data/order
                      racket/contract
                      racket/dict
                      racket/base))
@@ -8,8 +9,7 @@
 @title{Splay Trees}
 
 @(define the-eval (make-base-eval))
-@(the-eval '(require data/splay-tree))
+@(the-eval '(require racket/dict data/order data/splay-tree))
-@(the-eval '(require racket/dict))
 
 @defmodule[data/splay-tree]
 
@@ -20,27 +20,28 @@ with totally ordered keys. They were described in the paper
 ``Self-Adjusting Binary Search Trees'' by Daniel Sleator and Robert
 Tarjan in Journal of the ACM 32(3) pp652-686.
 
-A splay-tree is a dictionary (@racket[dict?] from
+A splay-tree is a ordered dictionary (@racket[dict?] and
-@racketmodname[racket/dict]). It also supports extensions of the
+@racket[ordered-dict?]).
-dictionary interface for iterator-based search.
 
-@defproc[(make-splay-tree [=? (-> any/c any/c any/c)]
+@defproc[(make-splay-tree [ord order? datum-order]
-                          [<? (-> any/c any/c any/c)]
                           [#:key-contract key-contract contract? any/c]
                           [#:value-contract value-contract contract? any/c])
          splay-tree?]{
 
-Makes a new empty splay-tree. The splay tree uses @racket[=?] and
+Makes a new empty splay-tree. The splay tree uses @racket[ord] to
-@racket[<?] to compare keys.
+order keys; in addition, the domain contract of @racket[ord] is
+combined with @racket[key-contract] to check keys.
 
 @examples[#:eval the-eval
-(define splay-tree (make-splay-tree string=? string<?))
+(define splay-tree
+  (make-splay-tree (order 'string-order string? string=? string<?)))
 (splay-tree-set! splay-tree "dot" 10)
 (splay-tree-set! splay-tree "cherry" 500)
 (dict-map splay-tree list)
 (splay-tree-ref splay-tree "dot")
 (splay-tree-remove! splay-tree "cherry")
 (splay-tree-count splay-tree)
+(splay-tree-set! splay-tree 'pear 3)
 ]
 }
 
@@ -142,19 +143,24 @@ This operation is only allowed on adjustable splay trees, and it takes
 }
 
 @deftogether[[
-@defproc[(splay-tree-iterate-greatest/<? [s splay-tree?] [key any/c])
+@defproc[(splay-tree-iterate-least [s splay-tree])
          (or/c #f splay-tree-iter?)]
-@defproc[(splay-tree-iterate-greatest/<=? [s splay-tree?] [key any/c])
+@defproc[(splay-tree-iterate-greatest [s splay-tree])
          (or/c #f splay-tree-iter?)]
 @defproc[(splay-tree-iterate-least/>? [s splay-tree?] [key any/c])
          (or/c #f splay-tree-iter?)]
 @defproc[(splay-tree-iterate-least/>=? [s splay-tree?] [key any/c])
-         (or/c #f splay-tree-iter?)]]]{
+         (or/c #f splay-tree-iter?)]
+@defproc[(splay-tree-iterate-greatest/<? [s splay-tree?] [key any/c])
+         (or/c #f splay-tree-iter?)]
+@defproc[(splay-tree-iterate-greatest/<=? [s splay-tree?] [key any/c])
+         (or/c #f splay-tree-iter?)]
+]]{
 
-Return the position of, respectively, the greatest key less than
+Implementations of @racket[dict-iterate-least],
-@racket[key], the greatest key less than or equal to @racket[key], the
+@racket[dict-iterate-greatest], @racket[dict-iterate-least/>?],
-least key greater than @racket[key], and the least key greater than or
+@racket[dict-iterate-least/>=?], @racket[dict-iterate-greatest/<?],
-equal to @racket[key].
+and @racket[dict-iterate-greatest/<=?], respectively.
 }
 
 @defproc[(splay-tree-iter? [x any/c]) boolean?]{

collects/data/skip-list.rkt

@@ -2,7 +2,7 @@
 (require racket/match
          racket/contract
          racket/dict
-         "private/ordered-dict.rkt")
+         "order.rkt")
 ;; owned by ryanc
 
 #|
@@ -151,7 +151,7 @@ Levels are indexed starting at 1, as in the paper.
                 ;; t-item greatest s.t. key(t-item) <? t-key (at level)
                 [t-item* (item-next t-item level)]) ;; key(t-item*) >=? t-key
            (set-item-next! f-item level t-item*)
-           (delete-range f-item t-item (sub1 level) f-key t-key <?))]
+           (delete-range f-item t-item (sub1 level) f-key t-key <? contract!?))]
         [else
          ;; f-item is greatest s.t. key(item) <? f-key
          ;; so f-item is greatest s.t. key(item) <? t-key,
@@ -315,12 +315,12 @@ Levels are indexed starting at 1, as in the paper.
          [item (item-next item 1)])
     (and item (skip-list-iter s item))))
 
-(define (skip-list-iterate-min s)
+(define (skip-list-iterate-least s)
   (let* ([head (skip-list-head s)]
          [item (item-next head 1)])
     (and item (skip-list-iter s item))))
 
-(define (skip-list-iterate-max s)
+(define (skip-list-iterate-greatest s)
   (let* ([head (skip-list-head s)]
          [item (closest head (item-level head)
                         ;; replace standard comparison with "always <",
@@ -351,8 +351,8 @@ Levels are indexed starting at 1, as in the paper.
                     skip-list-iterate-value))
 
 (define ordered-dict-methods
-  (vector-immutable skip-list-iterate-min
+  (vector-immutable skip-list-iterate-least
-                    skip-list-iterate-max
+                    skip-list-iterate-greatest
                     skip-list-iterate-least/>?
                     skip-list-iterate-least/>=?
                     skip-list-iterate-greatest/<?
@@ -389,13 +389,17 @@ Levels are indexed starting at 1, as in the paper.
                                 #f))
         #:property prop:ordered-dict ordered-dict-methods)
 
-(define (make-skip-list =? <?
+(define (make-skip-list [ord datum-order]
                         #:key-contract [key-contract any/c]
                         #:value-contract [value-contract any/c])
-  (cond [(and (eq? key-contract any/c) (eq? value-contract any/c))
+  (let ([key-contract (and/c* (order-domain-contract ord) key-contract)]
-         (skip-list (vector 'head 'head #f) 0 =? <?)]
+        [=? (order-=? ord)]
-        [else
+        [<? (order-<? ord)])
-         (skip-list* (vector 'head 'head #f) 0 =? <? key-contract value-contract)]))
+    (cond [(and (eq? key-contract any/c) (eq? value-contract any/c))
+           (skip-list (vector 'head 'head #f) 0 =? <?)]
+          [else
+           (skip-list* (vector 'head 'head #f) 0 =? <?
+                       key-contract value-contract)])))
 
 (define (make-adjustable-skip-list #:key-contract [key-contract any/c]
                                    #:value-contract [value-contract any/c])
@@ -405,21 +409,28 @@ Levels are indexed starting at 1, as in the paper.
          (adjustable-skip-list* (vector 'head 'head #f) 0 = <
                                 key-contract value-contract)]))
 
+
 (define (key-c s)
   (cond [(skip-list*? s) (skip-list*-key-c s)]
         [(adjustable-skip-list*? s)
-         (let ([key-c (adjustable-skip-list*-key-c s)])
+         (and/c* exact-integer? (adjustable-skip-list*-key-c s))]
-           (if (eq? key-c any/c) exact-integer? (and/c exact-integer? key-c)))]
         [else any/c]))
 (define (val-c s)
   (cond [(skip-list*? s) (skip-list*-value-c s)]
         [(adjustable-skip-list*? s) (adjustable-skip-list*-value-c s)]
         [else any/c]))
 
+(define (and/c* x y)
+  (cond [(eq? x any/c) y]
+        [(eq? y any/c) x]
+        [else (and/c x y)]))
+
+;; ============================================================
+
 (provide/contract
  [make-skip-list
-  (->* ((-> any/c any/c any/c) (-> any/c any/c any/c))
+  (->* ()
-       (#:key-contract contract? #:value-contract contract?)
+       (order? #:key-contract contract? #:value-contract contract?)
        skip-list?)]
  [make-adjustable-skip-list
   (->* ()
@@ -469,9 +480,9 @@ Levels are indexed starting at 1, as in the paper.
  [skip-list-iterate-least/>?
   (->i ([s skip-list?] [k (s) (key-c s)]) [_ (or/c skip-list-iter? #f)])]
 
- [skip-list-iterate-min
+ [skip-list-iterate-least
   (-> skip-list? (or/c skip-list-iter? #f))]
- [skip-list-iterate-max
+ [skip-list-iterate-greatest
   (-> skip-list? (or/c skip-list-iter? #f))]
 
  [skip-list-iter?

collects/data/splay-tree.rkt

@@ -4,7 +4,7 @@
          racket/match
          racket/dict
          racket/contract
-         "private/ordered-dict.rkt")
+         "order.rkt")
 
 #|
 This library contains two implementations of splay trees.
@@ -473,9 +473,9 @@ Options
 (define (n:splay-tree-iterate-least/>? s key)
   (n:extreme s key '(>) n:has-next? n:find-next))
 
-(define (n:splay-tree-iterate-min s)
+(define (n:splay-tree-iterate-least s)
   (n:splay-tree-iterate-first s))
-(define (n:splay-tree-iterate-max s)
+(define (n:splay-tree-iterate-greatest s)
   (match s
     [(node-splay-tree root size)
      (let-values ([(ok? root) (n:find-max root)])
@@ -515,8 +515,8 @@ Options
                     n:splay-tree-iterate-value))
 
 (define n:ordered-dict-methods
-  (vector-immutable n:splay-tree-iterate-min
+  (vector-immutable n:splay-tree-iterate-least
-                    n:splay-tree-iterate-max
+                    n:splay-tree-iterate-greatest
                     n:splay-tree-iterate-least/>?
                     n:splay-tree-iterate-least/>=?
                     n:splay-tree-iterate-greatest/<?
@@ -744,7 +744,7 @@ Top-down splay
   (let loop ([root root])
     (let-values ([(ok? root)
                   (v:extreme* mem root cmp from '(> =) v:has-next? v:find-next)])
-      (if (and ok? (eq? (cmp (vnode-key mem root) '<) to))
+      (if (and ok? (eq? (cmp (vnode-key mem root) to) '<))
           (loop (v:delete-root mem root cmp))
           root))))
 
@@ -897,9 +897,9 @@ Top-down splay
 (define (v:splay-tree-iterate-least/>? s key)
   (v:extreme s key '(>) v:has-next? v:find-next))
 
-(define (v:splay-tree-iterate-min s)
+(define (v:splay-tree-iterate-least s)
   (v:splay-tree-iterate-first s))
-(define (v:splay-tree-iterate-max s)
+(define (v:splay-tree-iterate-greatest s)
   (match s
     [(compact-splay-tree mem root cmp)
      (let-values ([(ok? root) (v:find-max mem root)])
@@ -935,8 +935,8 @@ Top-down splay
                     v:splay-tree-iterate-value))
 
 (define v:ordered-dict-methods
-  (vector-immutable v:splay-tree-iterate-min
+  (vector-immutable v:splay-tree-iterate-least
-                    v:splay-tree-iterate-max
+                    v:splay-tree-iterate-greatest
                     v:splay-tree-iterate-least/>?
                     v:splay-tree-iterate-least/>=?
                     v:splay-tree-iterate-greatest/<?
@@ -970,26 +970,12 @@ Top-down splay
 ;; Constructors, predicates
 ;; ============================================================
 
-(define (*make-splay-tree cmp key-contract value-contract)
+(define (make-splay-tree [ord datum-order]
-  (let ([mem (make-vector (* NODE-SIZE 4) #f)])
-    (set-vnode-key! mem scratch 4)
-    (cond [(and (eq? key-contract any/c) (eq? value-contract any/c))
-           (compact-splay-tree mem #f cmp)]
-          [else
-           (compact-splay-tree* mem #f cmp key-contract value-contract)])))
-
-(define (make-splay-tree =? <?
                          #:key-contract [key-contract any/c]
                          #:value-contract [value-contract any/c])
-  (*make-splay-tree (mkcmp <? =?) key-contract value-contract))
+  (*make-splay-tree (order-comparator ord)
-
+                    (and/c* (order-domain-contract ord) key-contract)
-(define (make-natural-splay-tree #:key-contract [key-contract any/c]
+                    value-contract))
-                                 #:value-contract [value-contract any/c])
-  (*make-splay-tree natural-cmp key-contract value-contract))
-
-(define (make-datum-splay-tree #:key-contract [key-contract any/c]
-                               #:value-contract [value-contract any/c])
-  (*make-splay-tree natural-cmp key-contract value-contract))
 
 (define (make-adjustable-splay-tree #:key-contract [key-contract any/c]
                                     #:value-contract [value-contract any/c])
@@ -998,13 +984,24 @@ Top-down splay
         [else
          (node-splay-tree* #f 0 key-contract value-contract)]))
 
+(define (*make-splay-tree cmp key-contract value-contract)
+  (let ([mem (make-vector (* NODE-SIZE 4) #f)])
+    (set-vnode-key! mem scratch 4)
+    (cond [(and (eq? key-contract any/c) (eq? value-contract any/c))
+           (compact-splay-tree mem #f cmp)]
+          [else
+           (compact-splay-tree* mem #f cmp key-contract value-contract)])))
+
 (define (splay-tree? x)
   (or (node-splay-tree? x) (compact-splay-tree? x)))
 
 (define (adjustable-splay-tree? s)
   (node-splay-tree? s))
 
-
+(define (and/c* x y)
+  (cond [(eq? x any/c) y]
+        [(eq? y any/c) x]
+        [else (and/c x y)]))
 
 ;; ============================================================
 ;; Splay trees
@@ -1041,8 +1038,8 @@ Top-down splay
   (splay-tree-iterate-greatest/<? s key)
   (splay-tree-iterate-least/>=? s key)
   (splay-tree-iterate-least/>? s key)
-  (splay-tree-iterate-min s)
+  (splay-tree-iterate-least s)
-  (splay-tree-iterate-max s)
+  (splay-tree-iterate-greatest s)
   (splay-tree->list s))
 
 
@@ -1053,8 +1050,7 @@ Top-down splay
 (define (key-c s)
   (cond [(compact-splay-tree*? s) (compact-splay-tree*-key-c s)]
         [(node-splay-tree*? s)
-         (let ([c (node-splay-tree*-key-c s)])
+         (and/c* exact-integer? (node-splay-tree*-key-c s))]
-           (if (eq? c any/c) exact-integer? (and/c exact-integer? c)))]
         [(node-splay-tree? s) exact-integer?]
         [else any/c]))
 (define (val-c s)
@@ -1064,8 +1060,8 @@ Top-down splay
 
 (provide/contract
  [make-splay-tree
-  (->* ((-> any/c any/c any) (-> any/c any/c any))
+  (->* ()
-       (#:key-contract contract? #:value-contract contract?)
+       (order? #:key-contract contract? #:value-contract contract?)
        splay-tree?)]
  [make-adjustable-splay-tree
   (->* ()
@@ -1123,9 +1119,9 @@ Top-down splay
  [splay-tree-iterate-least/>?
   (->i ([s splay-tree?] [k (s) (key-c s)]) [_ (or/c splay-tree-iter? #f)])]
 
- [splay-tree-iterate-min
+ [splay-tree-iterate-least
   (-> splay-tree? (or/c splay-tree-iter? #f))]
- [splay-tree-iterate-max
+ [splay-tree-iterate-greatest
   (-> splay-tree? (or/c splay-tree-iter? #f))]
 
  [splay-tree-iter? (-> any/c boolean?)])

collects/tests/data/ordered-dict.rkt

@@ -1,9 +1,10 @@
 #lang racket/base
 (require rackunit
+         racket/contract
          racket/dict
          data/skip-list
          data/splay-tree
-         data/private/ordered-dict)
+         data/order)
 
 ;; Tests for ordered dictionaries
 ;;   - skip-list
@@ -92,10 +93,17 @@
               dict-iterate-greatest/<?
               dict-iterate-greatest/<=?)))
 
-(test-case "skip-list, dict interface"
+(test-case "skip-list, datum-order, dict interface"
-  (dict-test (list (make-skip-list = <)) #t #t))
+  (dict-test (list (make-skip-list)) #t #t))
-(test-case "splay-tree, dict interface"
+(test-case "skip-list, < = order, dict interface"
-  (dict-test (list (make-splay-tree = <)) #t #t))
+  (dict-test (list (make-skip-list (order 'my-order any/c = <))) #t #t))
+(test-case "adjustable-skip-list, dict interface"
+  (dict-test (list (make-adjustable-skip-list)) #t #t))
+
+(test-case "splay-tree, datum-order, dict interface"
+  (dict-test (list (make-splay-tree)) #t #t))
+(test-case "splay-tree, < = order, dict interface"
+  (dict-test (list (make-splay-tree (order 'mine any/c = <))) #t #t))
 (test-case "adjustable-splay-tree, dict interface"
   (dict-test (list (make-adjustable-splay-tree)) #t #t))
 
@@ -116,10 +124,12 @@
               splay-tree-iterate-greatest/<?
               splay-tree-iterate-greatest/<=?)))
 
-(test-case "splay-tree, splay-tree interface"
+(test-case "splay-tree, datum-order, custom interface"
-  (splay-test (list (make-splay-tree = <)) #t #t))
+  (splay-test (list (make-splay-tree)) #t #t))
+(test-case "splay-tree, < = order, custom interface"
+  (splay-test (list (make-splay-tree (order 'mine any/c = <))) #t #t))
 
-(test-case "adjustable-splay-tree, splay-tree interface"
+(test-case "adjustable-splay-tree, custom interface"
   (splay-test (list (make-adjustable-splay-tree)) #t #t))
 
 (provide splay-test)
@@ -139,8 +149,14 @@
               skip-list-iterate-greatest/<?
               skip-list-iterate-greatest/<=?)))
 
-(test-case "skip-list, skip-list interface"
+(test-case "skip-list, datum-order, custom interface"
-  (skip-test (list (make-skip-list = <)) #t #t))
+  (skip-test (list (make-skip-list)) #t #t))
+
+(test-case "skip-list, < = order, custom interface"
+  (skip-test (list (make-skip-list (order 'mine any/c = <))) #t #t))
+
+(test-case "adjustable-skip-list, custom interface"
+  (skip-test (list (make-adjustable-skip-list)) #t #t))
 
 (provide skip-test)
 
@@ -169,6 +185,8 @@
 ;; ============================================================
 
 (define (p name testf mkd ordered?)
+  (collect-garbage)
+  (collect-garbage)
   (let-values ([(_result cpu real gc)
                 (time-apply
                  (lambda ()
@@ -177,18 +195,16 @@
                  null)])
     (printf "~a : ~s\n" name cpu)))
 
-(define (mksplay) (make-splay-tree = <))
+(define (mksplay) (make-splay-tree))
 (define (mkadj) (make-adjustable-splay-tree))
-(define (mkcsplay) (make-splay-tree = < #:key-contract number? #:value-contract number?))
+(define (mkcsplay) (make-splay-tree real-order))
-(define (mkdsplay) (make-datum-splay-tree))
+(define (mkskip) (make-skip-list))
-(define (mkskip) (make-skip-list = <))
+(define (mkcskip) (make-skip-list real-order))
-(define (mkcskip) (make-skip-list = < #:key-contract number? #:value-contract number?))
 
 (define (performance)
   (display "Using ordered-dict interface, w/ search\n")
   (p "splay-tree" dict-test mksplay #t)
   (p "adj splay " dict-test mkadj #t)
-  (p "dat splay " dict-test mkdsplay #t)
   (p "skip-list " dict-test mkskip #t)
   (p "splay w/ c" dict-test mkcsplay #t)
   (p "skip w/ c " dict-test mkcskip #t)
@@ -196,7 +212,6 @@
   (display "Using custom interfaces, w/ search\n")
   (p "splay-tree" splay-test mksplay #t)
   (p "adj splay " splay-test mkadj #t)
-  (p "dat splay " splay-test mkdsplay #t)
   (p "skip-list " skip-test mkskip #t)
   (p "splay w/ c" splay-test mkcsplay #t)
   (p "skip w/ c " skip-test mkcskip #t)
@@ -204,7 +219,6 @@
   (display "Using custom interfaces, w/o search\n")
   (p "splay-tree" splay-test mksplay #f)
   (p "adj splay " splay-test mksplay #f)
-  (p "dat splay " splay-test mkdsplay #f)
   (p "skip-list " skip-test mkskip #f)
   (p "splay w/ c" splay-test mkcsplay #f)
   (p "skip w/ c " skip-test mkcskip #f)