1 files changed, 95 insertions, 2 deletions
diff --git a/src/clojure/contrib/generic/comparison.clj b/src/clojure/contrib/generic/comparison.clj
index 6bd34184..237a8e98 100644
--- a/src/clojure/contrib/generic/comparison.clj
+++ b/src/clojure/contrib/generic/comparison.clj
@@ -1,7 +1,7 @@
 ;; Generic interfaces for comparison operations
 
 ;; by Konrad Hinsen
-;; last updated March 19, 2009
+;; last updated March 23, 2009
 
 ;; Copyright (c) Konrad Hinsen, 2009. All rights reserved.  The use
 ;; and distribution terms for this software are covered by the Eclipse
@@ -18,7 +18,8 @@
    with future release.
 
    This library defines generic versions of = < > <= >= zero? as multimethods
-   that can be defined for any type."
+   that can be defined for any type. Of the greater/less-than relations,
+   types must minimally implement >."
   (:refer-clojure :exclude [= < > <= >= zero?])
   (:use [clojure.contrib.generic
 	 :only (root-type nulary-type nary-type nary-dispatch)]))
@@ -45,6 +46,82 @@
     false))
 
 ;
+; Greater-than
+;
+(defmulti > nary-dispatch)
+
+(defmethod > root-type
+  [x] true)
+
+(defmethod > nary-type
+  [x y & more]
+  (if (> x y)
+    (if (next more)
+      (recur y (first more) (next more))
+      (> y (first more)))
+    false))
+
+;
+; Less-than defaults to greater-than with arguments inversed
+;
+(defmulti < nary-dispatch)
+
+(defmethod < root-type
+  [x] true)
+
+(defmethod < [root-type root-type]
+  [x y]
+  (> y x))
+
+(defmethod < nary-type
+  [x y & more]
+  (if (< x y)
+    (if (next more)
+      (recur y (first more) (next more))
+      (< y (first more)))
+    false))
+
+;
+; Greater-or-equal defaults to (complement <)
+;
+(defmulti >= nary-dispatch)
+
+(defmethod >= root-type
+  [x] true)
+
+(defmethod >= [root-type root-type]
+  [x y]
+  (not (< x y)))
+
+(defmethod >= nary-type
+  [x y & more]
+  (if (>= x y)
+    (if (next more)
+      (recur y (first more) (next more))
+      (>= y (first more)))
+    false))
+
+;
+; Less-than defaults to (complement >)
+;
+(defmulti <= nary-dispatch)
+
+(defmethod <= root-type
+  [x] true)
+
+(defmethod >= [root-type root-type]
+  [x y]
+  (not (> x y)))
+
+(defmethod <= nary-type
+  [x y & more]
+  (if (<= x y)
+    (if (next more)
+      (recur y (first more) (next more))
+      (<= y (first more)))
+    false))
+
+;
 ; Implementations for Clojure's built-in types
 ;
 (defmethod zero? java.lang.Number
@@ -54,3 +131,19 @@
 (defmethod = [Object Object]
   [x y]
   (clojure.core/= x y))
+
+(defmethod > [Object Object]
+  [x y]
+  (clojure.core/> x y))
+
+(defmethod < [Object Object]
+  [x y]
+  (clojure.core/< x y))
+
+(defmethod >= [Object Object]
+  [x y]
+  (clojure.core/>= x y))
+
+(defmethod <= [Object Object]
+  [x y]
+  (clojure.core/<= x y))