From 7781b8e47dd7d944c87b7de4670fdcc132d08b45 Mon Sep 17 00:00:00 2001
From: Ken Harris <kengruven@gmail.com>
Date: Thu, 13 Jun 2013 10:16:51 -0700
Subject: [PATCH] STRING>= (and a bit of refactoring).

---
 src/string.lisp    |   85 ++++++++++++++++++++++------------------------------
 tests/strings.lisp |   63 +++++++++++++++++++-------------------
 2 files changed, 67 insertions(+), 81 deletions(-)

diff --git a/src/string.lisp b/src/string.lisp
index ecfa070..91ab8c3 100644
--- a/src/string.lisp
+++ b/src/string.lisp
@@ -57,64 +57,51 @@
       (unless (char= (char s1 (+ start1 i)) (char s2 (+ start2 i)))
 	(return-from string/= (+ start1 i))))))
 
-(defun string< (s1 s2 &key (start1 0) end1 (start2 0) end2)
+
+(defun compare-strings (s1 s2 start1 end1 start2 end2 char-eq char-lt if-eq if-a-sub-b if-b-sub-a)
+  ;; step through strings S1 and S2, using bounds START1 END1 START2 END2.
+  ;; using character comparison functions CHAR-EQ (equality) and CHAR-LT (less-than),
+  ;; find the first difference, if any, and return its index.
+  ;; the IF-* params say what to do if the strings are equal, or a strict prefix substring of the other:
+  ;; if T, it returns the first different index.  if NIL, it returns NIL.
   (let* ((s1 (string s1))
          (s2 (string s2))
 	 (end1 (or end1 (length s1)))
 	 (end2 (or end2 (length s2)))
 	 (len-1 (- end1 start1))
 	 (len-2 (- end2 start2)))
-    (cond ((= len-2 0) nil)
-          ((= len-1 0) 0)
-          (t (dotimes (i len-1 nil)
-	       (when (= i len-2)  ;; ran off the end of s2
-		 (return-from string< nil))
-               (when (char< (char s1 (+ start1 i)) (char s2 (+ start2 i)))  ;; found a difference
-                 (return-from string< (+ start1 i)))
-               (when (char> (char s1 (+ start1 i)) (char s2 (+ start2 i)))  ;; found a difference
-                 (return-from string< nil))
-               (when (and (= i (1- len-1)) (> len-2 len-1))  ;; ran off the end of s1
-                 (return-from string< (+ start1 i 1))))))))
-
-;; just like string< but with everything flipped, except the result is still relative to s1
+    (dotimes (i (max len-1 len-2) (if if-eq (+ start1 i) nil))
+      (when (= i len-1)  ;; ran off the end of s1
+	(return-from compare-strings (if if-a-sub-b (+ start1 i) nil)))
+      (when (= i len-2)  ;; ran off the end of s2
+	(return-from compare-strings (if if-b-sub-a (+ start1 i) nil)))
+      (let ((c1 (char s1 (+ start1 i)))
+	    (c2 (char s2 (+ start2 i))))
+	(when (not (funcall char-eq c1 c2))  ;; found a difference
+	  (return-from compare-strings
+		       (if (not (funcall char-lt c1 c2))
+			   (+ start1 i)
+			 nil)))))))
+
+(defun string< (s1 s2 &key (start1 0) end1 (start2 0) end2)
+  (compare-strings s1 s2 start1 end1 start2 end2
+		   #'char= #'char>
+		   nil t nil))
+
 (defun string> (s1 s2 &key (start1 0) end1 (start2 0) end2)
-  (let* ((s1 (string s1))
-         (s2 (string s2))
-	 (end1 (or end1 (length s1)))
-	 (end2 (or end2 (length s2)))
-	 (len-1 (- end1 start1))
-	 (len-2 (- end2 start2)))
-    (cond ((= len-1 0) nil)
-          ((= len-2 0) 0)
-          (t (dotimes (i len-2 nil)
-	       (when (= i len-1)  ;; ran off the end of s1
-		 (return-from string> nil))
-               (when (char> (char s1 (+ start1 i)) (char s2 (+ start2 i)))  ;; found a difference
-                 (return-from string> (+ start1 i)))
-               (when (char< (char s1 (+ start1 i)) (char s2 (+ start2 i)))  ;; found a difference
-                 (return-from string> nil))
-               (when (and (= i (1- len-2)) (> len-1 len-2))  ;; ran off the end of s2
-                 (return-from string> (+ start1 i 1))))))))
+  (compare-strings s1 s2 start1 end1 start2 end2
+		   #'char= #'char<
+		   nil nil t))
 
 (defun string<= (s1 s2 &key (start1 0) end1 (start2 0) end2)
-  (let* ((s1 (string s1))
-         (s2 (string s2))
-	 (end1 (or end1 (length s1)))
-	 (end2 (or end2 (length s2)))
-	 (len-1 (- end1 start1))
-	 (len-2 (- end2 start2)))
-    (dotimes (i len-1 end1)
-      (when (= i len-2)  ;; ran off the end of s2
-	(return-from string<= nil))
-      (when (char/= (char s1 (+ start1 i)) (char s2 (+ start2 i)))  ;; found a difference
-	(return-from string<=
-		     (if (char< (char s1 (+ start1 i)) (char s2 (+ start2 i)))
-			 (+ start1 i)
-		       nil)))
-      (when (and (= i (1- len-1)) (> len-2 len-1))  ;; ran off the end of s1
-	(return-from string<= (+ start1 i 1))))))
-
-;; TODO: string>=
+  (compare-strings s1 s2 start1 end1 start2 end2
+		   #'char= #'char>
+		   t t nil))
+  
+(defun string>= (s1 s2 &key (start1 0) end1 (start2 0) end2)
+  (compare-strings s1 s2 start1 end1 start2 end2
+		   #'char= #'char<
+		   t nil t))
 
 (define-setf-expander char (string index)
   (let ((g!string (gensym))
diff --git a/tests/strings.lisp b/tests/strings.lisp
index fd4b56e..ccfc5e5 100644
--- a/tests/strings.lisp
+++ b/tests/strings.lisp
@@ -253,8 +253,7 @@
 (test (string-equal "foo" "Foo"))
 (test (string= "abcd" "01234abcd9012" :start2 5 :end2 9))
 (test (eql (string< "aaaa" "aaab") 3))
-;; JSCL: STRING>= doesn't exist yet, disabled
-;; (test (eql (string>= "aaaaa" "aaaa") 4))
+(test (eql (string>= "aaaaa" "aaaa") 4))
 ;; JSCL: STRING-NOT-GREATERP doesn't exist yet, disabling:
 ;; (test (eql (string-not-greaterp "Abcde" "abcdE") 5))
 ;; (test (eql (string-lessp "012AAAA789" "01aaab6"
@@ -407,38 +406,38 @@
 (test (not (string<= #\z #\a)))
 
 
-;; (test (eql (string>= "" "") 0))
-;; (test (eql (string>= "dog" "dog") 3))
-;; (test (eql (string>= " " " ") 1))
-;; (test (eql (string>= "abc" "") 0))
-;; (test (not (string>= "" "abc")))
-;; (test (not (string>= "ab" "abc")))
-;; (test (eql (string>= "abc" "ab") 2))
-;; (test (eql (string>= "aba" "aaa") 1))
-;; (test (not (string>= "aaa" "aba")))
-;; (test (eql (string>= "my cat food" "your dog food" :start1 6 :start2 8) 11))
-;; (test (eql (string>= "cat food 2 dollars" "dog food 3 dollars"
-;; 	       :start1 3 :end1 9 :start2 3 :end2 9) 9))
-;; (test (eql (string>= "xyzabcde" "abcd" :start1 3) 7))
-;; (test (not (string>= "abc" "abc" :end1 1)))
-;; (test (eql (string>= "xyzabc" "a" :start1 3 :end1 5) 4))
-;; (test (eql (string>= "xyzXYZ" "abcxyz" :start2 3) 3))
-;; (test (eql (string>= "abcxyz" "abcxyz" :end2 3) 3))
-;; (test (not (string>= "xyzXYZ" "abcxyz" :end1 2 :start2 3)))
-;; (test (eql (string>= "xyzabc" "abcdef" :start1 3 :end2 3) 6))
-;; (test (eql (string>= "z" "aaaa") 0))
-;; (test (eql (string>= "pTTTxTTTqqq" "pppTTTaTTT" :start1 1 :start2 3) 4))
-;; (test (eql (string>= "pppTTTxTTTqqq" "pTTTaTTT"
-;; 	       :start1 6 :end1 7
-;; 	       :start2 4 :end2 5) 6))
+(test (eql (string>= "" "") 0))
+(test (eql (string>= "dog" "dog") 3))
+(test (eql (string>= " " " ") 1))
+(test (eql (string>= "abc" "") 0))
+(test (not (string>= "" "abc")))
+(test (not (string>= "ab" "abc")))
+(test (eql (string>= "abc" "ab") 2))
+(test (eql (string>= "aba" "aaa") 1))
+(test (not (string>= "aaa" "aba")))
+(test (eql (string>= "my cat food" "your dog food" :start1 6 :start2 8) 11))
+(test (eql (string>= "cat food 2 dollars" "dog food 3 dollars"
+	       :start1 3 :end1 9 :start2 3 :end2 9) 9))
+(test (eql (string>= "xyzabcde" "abcd" :start1 3) 7))
+(test (not (string>= "abc" "abc" :end1 1)))
+(test (eql (string>= "xyzabc" "a" :start1 3 :end1 5) 4))
+(test (eql (string>= "xyzXYZ" "abcxyz" :start2 3) 3))
+(test (eql (string>= "abcxyz" "abcxyz" :end2 3) 3))
+(test (not (string>= "xyzXYZ" "abcxyz" :end1 2 :start2 3)))
+(test (eql (string>= "xyzabc" "abcdef" :start1 3 :end2 3) 6))
+(test (eql (string>= "z" "aaaa") 0))
+(test (eql (string>= "pTTTxTTTqqq" "pppTTTaTTT" :start1 1 :start2 3) 4))
+(test (eql (string>= "pppTTTxTTTqqq" "pTTTaTTT"
+	       :start1 6 :end1 7
+	       :start2 4 :end2 5) 6))
 ;; (test (eql (string>= (make-array 0 :element-type 'character)
 ;; 	       (make-array 0 :element-type 'base-char)) 0))
-;; (test (= (string>= 'love 'hate) 0))
-;; (test (not (string>= 'peace 'war)))
-;; (test (= (string>= 'love 'love) 4))
-;; (test (= (string>= #\a #\a) 1))
-;; (test (not (string>= #\a #\b)))
-;; (test (= (string>= #\z #\a) 0))
+(test (= (string>= 'love 'hate) 0))
+(test (not (string>= 'peace 'war)))
+(test (= (string>= 'love 'love) 4))
+(test (= (string>= #\a #\a) 1))
+(test (not (string>= #\a #\b)))
+(test (= (string>= #\z #\a) 0))
 
 
 
-- 
1.7.10.4