[movitz-cvs] CVS movitz/losp/muerte

[ffjeld]

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory clnet:/tmp/cvs-serv15213

Modified Files:
	strings.lisp 
Log Message:
Add string< and friends.


--- /project/movitz/cvsroot/movitz/losp/muerte/strings.lisp	2005/06/12 20:01:49	1.3
+++ /project/movitz/cvsroot/movitz/losp/muerte/strings.lisp	2008/04/17 19:36:09	1.4
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Fri Oct 19 17:05:25 2001
 ;;;;                
-;;;; $Id: strings.lisp,v 1.3 2005/06/12 20:01:49 ffjeld Exp $
+;;;; $Id: strings.lisp,v 1.4 2008/04/17 19:36:09 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -99,5 +99,97 @@
 	   (t (setf between-words-p (not (char-alpha-p c)))
 	      (char-downcase c))))))))
 				
-       
-      
+(defun string%<= (string1 string2 result= start1 end1 start2 end2)
+  (let ((mismatch (mismatch string1 string2
+			    :start1 start1
+			    :end1 end1
+			    :start2 start2
+			    :end2 end2
+			    :test #'char=)))
+    (cond
+      ((not mismatch)
+       (when result=
+	 (or end1 (length string1))))
+      ((>= mismatch (or end1 (length string1)))
+       mismatch)
+      ((>= mismatch (or end2 (length string2)))
+       nil)
+      (t (when (char< (char string1 mismatch)
+		      (char string2 mismatch))
+	   mismatch)))))
+
+(defun string< (string1 string2 &key (start1 0) end1 (start2 0) end2)
+  "=> mismatch-index"
+  (let ((mismatch (mismatch string1 string2
+			    :start1 start1
+			    :end1 end1
+			    :start2 start2
+			    :end2 end2
+			    :test #'char=)))
+    (cond
+      ((not mismatch)
+       nil)
+      ((>= mismatch (or end1 (length string1)))
+       mismatch)
+      ((>= mismatch (or end2 (length string2)))
+       nil)
+      (t (when (char< (char string1 mismatch)
+		      (char string2 mismatch))
+	   mismatch)))))
+
+(defun string<= (string1 string2 &key (start1 0) end1 (start2 0) end2)
+  "=> mismatch-index"
+  (let ((mismatch (mismatch string1 string2
+			    :start1 start1
+			    :end1 end1
+			    :start2 start2
+			    :end2 end2
+			    :test #'char=)))
+    (cond
+      ((not mismatch)
+       (or end1 (length string1)))
+      ((>= mismatch (or end1 (length string1)))
+       mismatch)
+      ((>= mismatch (or end2 (length string2)))
+       nil)
+      (t (when (char<= (char string1 mismatch)
+		       (char string2 mismatch))
+	   mismatch)))))
+
+(defun string> (string1 string2 result= start1 end1 start2 end2)
+  "=> mismatch-index"
+  (let ((mismatch (mismatch string1 string2
+			    :start1 start1
+			    :end1 end1
+			    :start2 start2
+			    :end2 end2
+			    :test #'char=)))
+    (cond
+      ((not mismatch)
+       nil)
+      ((>= mismatch (or end1 (length string1)))
+       mismatch)
+      ((>= mismatch (or end2 (length string2)))
+       nil)
+      (t (when (char> (char string1 mismatch)
+		      (char string2 mismatch))
+	   mismatch)))))
+
+(defun string>= (string1 string2 result= start1 end1 start2 end2)
+  "=> mismatch-index"
+  (let ((mismatch (mismatch string1 string2
+			    :start1 start1
+			    :end1 end1
+			    :start2 start2
+			    :end2 end2
+			    :test #'char=)))
+    (cond
+      ((not mismatch)
+       (or end1 (length string1)))
+      ((>= mismatch (or end1 (length string1)))
+       mismatch)
+      ((>= mismatch (or end2 (length string2)))
+       nil)
+      (t (when (char>= (char string1 mismatch)
+		       (char string2 mismatch))
+	   mismatch)))))