0.8.9.6.netbsd.2:

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

diff --git a/src/code/string.lisp b/src/code/string.lisp
index 10e5dcd..b1fe487 100644 (file)
--- a/src/code/string.lisp
+++ b/src/code/string.lisp
@@ -23,19 +23,32 @@
        (t
         (error 'simple-type-error
                :datum x
-               :expected-type 'stringable
+               :expected-type 'string-designator
                :format-control "~S cannot be coerced to a string."
                :format-arguments (list x)))))
 
+;;; %CHECK-VECTOR-SEQUENCE-BOUNDS is used to verify that the START and
+;;; END arguments are valid bounding indices.
+;;;
+;;; FIXME: This causes a certain amount of double checking that could
+;;; be avoided, as if the string passes this (more stringent) test it
+;;; will automatically pass the tests in WITH-ARRAY-DATA.  Fixing this
+;;; would necessitate rearranging the transforms (maybe converting to
+;;; strings in the unasterisked versions and using this in the
+;;; transforms conditional on SAFETY>SPEED,SPACE).
+(defun %check-vector-sequence-bounds (vector start end)
+  (%check-vector-sequence-bounds vector start end))
+
 (eval-when (:compile-toplevel)
 ;;; WITH-ONE-STRING is used to set up some string hacking things. The
 ;;; keywords are parsed, and the string is hacked into a
 ;;; simple-string.
 (sb!xc:defmacro with-one-string ((string start end) &body forms)
-  `(let ((,string (if (stringp ,string) ,string (string ,string))))
+  `(let* ((,string (if (stringp ,string) ,string (string ,string))))
      (with-array-data ((,string ,string)
-                      (,start ,start)
-                      (,end (or ,end (length (the vector ,string)))))
+                      (,start ,start)
+                      (,end
+                       (%check-vector-sequence-bounds ,string ,start ,end)))
        ,@forms)))
 ;;; WITH-STRING is like WITH-ONE-STRING, but doesn't parse keywords.
 (sb!xc:defmacro with-string (string &rest forms)
@@ -52,10 +65,12 @@
         (,string2 (if (stringp ,string2) ,string2 (string ,string2))))
      (with-array-data ((,string1 ,string1 :offset-var ,cum-offset-1)
                       (,start1 ,start1)
-                      (,end1 (or ,end1 (length (the vector ,string1)))))
+                      (,end1 (%check-vector-sequence-bounds
+                              ,string1 ,start1 ,end1)))
        (with-array-data ((,string2 ,string2)
                         (,start2 ,start2)
-                        (,end2 (or ,end2 (length (the vector ,string2)))))
+                        (,end2 (%check-vector-sequence-bounds
+                                ,string2 ,start2 ,end2)))
         ,@forms))))
 ) ; EVAL-WHEN
 
@@ -94,8 +109,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 +131,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)
@@ -221,9 +236,6 @@
     (let ((slen1 (- (the fixnum end1) start1))
          (slen2 (- (the fixnum end2) start2)))
       (declare (fixnum slen1 slen2))
-      (if (or (minusp slen1) (minusp slen2))
-         ;;prevent endless looping later.
-         (error "Improper bounds for string comparison."))
       (if (= slen1 slen2)
          ;;return () immediately if lengths aren't equal.
          (string-not-equal-loop 1 t nil)))))
@@ -237,12 +249,7 @@
     (let ((slen1 (- end1 start1))
          (slen2 (- end2 start2)))
       (declare (fixnum slen1 slen2))
-      (if (or (minusp slen1) (minusp slen2))
-         ;; Prevent endless looping later.
-         (error "Improper bounds for string comparison."))
-      (cond ((or (minusp slen1) (or (minusp slen2)))
-            (error "Improper substring for comparison."))
-           ((= slen1 slen2)
+      (cond ((= slen1 slen2)
             (string-not-equal-loop 1 nil (- index1 offset1)))
            ((< slen1 slen2)
             (string-not-equal-loop 1 (- index1 offset1)))
@@ -274,9 +281,6 @@
        (let ((slen1 (- (the fixnum end1) start1))
             (slen2 (- (the fixnum end2) start2)))
         (declare (fixnum slen1 slen2))
-        (if (or (minusp slen1) (minusp slen2))
-            ;;prevent endless looping later.
-            (error "Improper bounds for string comparison."))
         (do ((index1 start1 (1+ index1))
              (index2 start2 (1+ index2))
              (char1)
@@ -338,19 +342,16 @@
   (using char-equal) of the two strings. Otherwise, returns ()."
   (string-not-greaterp* string1 string2 start1 end1 start2 end2))
 
-(defun make-string (count &key element-type ((:initial-element fill-char)))
+(defun make-string (count &key
+                   (element-type 'character)
+                   ((:initial-element fill-char)))
   #!+sb-doc
   "Given a character count and an optional fill character, makes and returns
-   a new string Count long filled with the fill character."
-  (declare (fixnum count)
-          (ignore element-type))
+   a new string COUNT long filled with the fill character."
+  (declare (fixnum count))
   (if fill-char
-      (do ((i 0 (1+ i))
-          (string (make-string count)))
-         ((= i count) string)
-       (declare (fixnum i))
-       (setf (schar string i) fill-char))
-      (make-string count)))
+      (make-string count :element-type element-type :initial-element fill-char)
+      (make-string count :element-type element-type)))
 
 (flet ((%upcase (string start end)
         (declare (string string) (index start) (type sequence-end end))