0.7.9.47:

[sbcl.git] / src / code / string.lisp

diff --git a/src/code/string.lisp b/src/code/string.lisp
index 3ffae90..28cb331 100644 (file)
--- a/src/code/string.lisp
+++ b/src/code/string.lisp
@@ -83,7 +83,7 @@
   (setf (schar string index) new-el))
 
 (defun string=* (string1 string2 start1 end1 start2 end2)
-  (with-two-strings string1 string2 start1 end1 offset1 start2 end2
+  (with-two-strings string1 string2 start1 end1 nil start2 end2
     (not (%sp-string-compare string1 start1 end1 string2 start2 end2))))
 
 (defun string/=* (string1 string2 start1 end1 start2 end2)
@@ -94,8 +94,8 @@
 
 (eval-when (:compile-toplevel :execute)
 
-;;; Lessp is true if the desired expansion is for string<* or string<=*.
-;;; Equalp is true if the desired expansion is for string<=* or string>=*.
+;;; LESSP is true if the desired expansion is for STRING<* or STRING<=*.
+;;; EQUALP is true if the desired expansion is for STRING<=* or STRING>=*.
 (sb!xc:defmacro string<>=*-body (lessp equalp)
   (let ((offset1 (gensym)))
     `(with-two-strings string1 string2 start1 end1 ,offset1 start2 end2
@@ -116,7 +116,7 @@
                     (schar string2 (+ (the fixnum index) (- start2 start1))))
                    (- (the fixnum index) ,offset1))
                   (t nil))
-            ,(if equalp `(- (the fixnum end1) ,offset1) 'nil))))))
+            ,(if equalp `(- (the fixnum end1) ,offset1) nil))))))
 ) ; EVAL-WHEN
 
 (defun string<* (string1 string2 start1 end1 start2 end2)
@@ -217,7 +217,7 @@
   start2, end1 and end2, compares characters in string1 to characters in
   string2 (using char-equal)."
   (declare (fixnum start1 start2))
-  (with-two-strings string1 string2 start1 end1 offset1 start2 end2
+  (with-two-strings string1 string2 start1 end1 nil start2 end2
     (let ((slen1 (- (the fixnum end1) start1))
          (slen2 (- (the fixnum end2) start2)))
       (declare (fixnum slen1 slen2))
@@ -352,61 +352,61 @@
        (setf (schar string i) fill-char))
       (make-string count)))
 
-(flet ((frob (string start end)
-        (declare (string string) (index start) (type (or index null end)))
-        (let ((save-header string))
+(flet ((%upcase (string start end)
+        (declare (string string) (index start) (type sequence-end end))
+        (let ((saved-header string))
           (with-one-string (string start end)
             (do ((index start (1+ index)))
                 ((= index (the fixnum end)))
               (declare (fixnum index))
               (setf (schar string index) (char-upcase (schar string index)))))
-          save-header)))
+          saved-header)))
 (defun string-upcase (string &key (start 0) end)
-  (frob (copy-seq string) start end))
+  (%upcase (copy-seq (string string)) start end))
 (defun nstring-upcase (string &key (start 0) end)
-  (frob string start end))
+  (%upcase string start end))
 ) ; FLET
 
-(flet ((frob (string start end)
-        (declare (string string) (index start) (type (or index null end)))
-        (let ((save-header string))
+(flet ((%downcase (string start end)
+        (declare (string string) (index start) (type sequence-end end))
+        (let ((saved-header string))
           (with-one-string (string start end)
             (do ((index start (1+ index)))
                 ((= index (the fixnum end)))
               (declare (fixnum index))
               (setf (schar string index)
                     (char-downcase (schar string index)))))
-          save-header)))
+          saved-header)))
 (defun string-downcase (string &key (start 0) end)
-  (frob (copy-seq string) start end))
+  (%downcase (copy-seq (string string)) start end))
 (defun nstring-downcase (string &key (start 0) end)
-  (frob string start end))
+  (%downcase string start end))
 ) ; FLET
 
-(flet ((frob (string start end)
-        (declare (string string) (index start) (type (or index null end)))
-        (let ((save-header string))
+(flet ((%capitalize (string start end)
+        (declare (string string) (index start) (type sequence-end end))
+        (let ((saved-header string))
            (with-one-string (string start end)
              (do ((index start (1+ index))
-                 (newword t)
-                 (char ()))
+                 (new-word? t)
+                 (char nil))
                 ((= index (the fixnum end)))
               (declare (fixnum index))
               (setq char (schar string index))
               (cond ((not (alphanumericp char))
-                     (setq newword t))
-              (newword
-               ;; CHAR is the first case-modifiable character after
-               ;; a sequence of non-case-modifiable characters.
-               (setf (schar string index) (char-upcase char))
-               (setq newword ()))
-              (t
-               (setf (schar string index) (char-downcase char))))))
-          save-header)))
+                     (setq new-word? t))
+                    (new-word?
+                     ;; CHAR is the first case-modifiable character after
+                     ;; a sequence of non-case-modifiable characters.
+                     (setf (schar string index) (char-upcase char))
+                     (setq new-word? nil))
+                    (t
+                     (setf (schar string index) (char-downcase char))))))
+          saved-header)))
 (defun string-capitalize (string &key (start 0) end)
-  (frob (copy-seq string) start end))
+  (%capitalize (copy-seq (string string)) start end))
 (defun nstring-capitalize (string &key (start 0) end)
-  (frob string start end))
+  (%capitalize string start end))
 ) ; FLET
 
 (defun string-left-trim (char-bag string)