[movitz-cvs] CVS movitz/losp/muerte

ffjeld ffjeld at common-lisp.net
Sun Apr 27 19:45:34 UTC 2008


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

Modified Files:
	strings.lisp 
Log Message:
Fix bug in string> & friends.


--- /project/movitz/cvsroot/movitz/losp/muerte/strings.lisp	2008/04/21 19:43:30	1.5
+++ /project/movitz/cvsroot/movitz/losp/muerte/strings.lisp	2008/04/27 19:45:33	1.6
@@ -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.5 2008/04/21 19:43:30 ffjeld Exp $
+;;;; $Id: strings.lisp,v 1.6 2008/04/27 19:45:33 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -52,7 +52,11 @@
 	   (return nil)))))
 
 (defun string-not-equal (string1 string2 &key (start1 0) end1 (start2 0) end2)
-  (not (string-equal string1 string2 :start1 start1 :end1 end1 :start2 start2 :end2 end2)))
+  (not (string-equal string1 string2
+		     :start1 start1
+		     :end1 end1
+		     :start2 start2
+		     :end2 end2)))
 
 (defun string (name)
   (typecase name
@@ -104,25 +108,6 @@
 	   (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
@@ -134,12 +119,14 @@
     (cond
       ((not mismatch)
        nil)
-      ((>= mismatch (or end1 (length string1)))
+      ((>= mismatch
+	   (or end1 (length string1)))
        mismatch)
-      ((>= mismatch (or end2 (length string2)))
+      ((>= (+ start2 mismatch)
+	   (or end2 (length string2)))
        nil)
       (t (when (char< (char string1 mismatch)
-		      (char string2 mismatch))
+		      (char string2 (+ start2 mismatch)))
 	   mismatch)))))
 
 (defun string<= (string1 string2 &key (start1 0) end1 (start2 0) end2)
@@ -153,12 +140,14 @@
     (cond
       ((not mismatch)
        (or end1 (length string1)))
-      ((>= mismatch (or end1 (length string1)))
+      ((>= mismatch
+	   (or end1 (length string1)))
        mismatch)
-      ((>= mismatch (or end2 (length string2)))
+      ((>= (+ start2 mismatch)
+	   (or end2 (length string2)))
        nil)
       (t (when (char<= (char string1 mismatch)
-		       (char string2 mismatch))
+		       (char string2 (+ start2 mismatch)))
 	   mismatch)))))
 
 (defun string> (string1 string2 result= start1 end1 start2 end2)
@@ -172,12 +161,14 @@
     (cond
       ((not mismatch)
        nil)
-      ((>= mismatch (or end1 (length string1)))
+      ((>= mismatch
+	   (or end1 (length string1)))
        mismatch)
-      ((>= mismatch (or end2 (length string2)))
+      ((>= (+ start2 mismatch)
+	   (or end2 (length string2)))
        nil)
       (t (when (char> (char string1 mismatch)
-		      (char string2 mismatch))
+		      (char string2 (+ start2 mismatch)))
 	   mismatch)))))
 
 (defun string>= (string1 string2 result= start1 end1 start2 end2)
@@ -191,10 +182,12 @@
     (cond
       ((not mismatch)
        (or end1 (length string1)))
-      ((>= mismatch (or end1 (length string1)))
+      ((>= mismatch
+	   (or end1 (length string1)))
        mismatch)
-      ((>= mismatch (or end2 (length string2)))
+      ((>= (+ start2 mismatch)
+	   (or end2 (length string2)))
        nil)
       (t (when (char>= (char string1 mismatch)
-		       (char string2 mismatch))
+		       (char string2 (+ start2 mismatch)))
 	   mismatch)))))




More information about the Movitz-cvs mailing list