STRING>= (and a bit of refactoring).

[jscl.git] / src / string.lisp

diff --git a/src/string.lisp b/src/string.lisp
index c9267f0..91ab8c3 100644 (file)
--- a/src/string.lisp
+++ b/src/string.lisp
@@ -57,48 +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))))))))
-
-;; TODO: string<=, string>=
-;; - mostly like string< / string>
-;; - if we run off the end of s1 and s2 at the same time, then it's =, so return len.
+  (compare-strings s1 s2 start1 end1 start2 end2
+                  #'char= #'char<
+                  nil nil t))
+
+(defun string<= (s1 s2 &key (start1 0) end1 (start2 0) end2)
+  (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))