X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fstring.lisp;h=f5aa2faba3a48af3e104b15a0b477e5a9f49d7b9;hb=cd13034f9415f64cdaa05893a4ac5ff1e95c97bd;hp=0482f5db3e80d329c1b0c403dc21745c13830e7c;hpb=e7c0037516c1a23f4bb48a99bfb5fa5d1781b8b1;p=sbcl.git diff --git a/src/code/string.lisp b/src/code/string.lisp index 0482f5d..f5aa2fa 100644 --- a/src/code/string.lisp +++ b/src/code/string.lisp @@ -27,15 +27,28 @@ :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 @@ -83,7 +98,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 +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) @@ -217,13 +232,10 @@ 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)) - (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))