(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)
(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
(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)
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))
(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)