1;;;; This software is part of the SBCL system. See the README file for 2;;;; more information. 3;;;; 4;;;; This software is derived from the CMU CL system, which was 5;;;; written at Carnegie Mellon University and released into the 6;;;; public domain. The software is in the public domain and is 7;;;; provided with absolutely no warranty. See the COPYING and CREDITS 8;;;; files for more information. 9 10(in-package "SB!IMPL") 11 12(eval-when (:compile-toplevel) 13 (sb!xc:defmacro %string (x) `(if (stringp ,x) ,x (string ,x)))) 14 15(defun string (x) 16 #!+sb-doc 17 "Coerces X into a string. If X is a string, X is returned. If X is a 18 symbol, its name is returned. If X is a character then a one element 19 string containing that character is returned. If X cannot be coerced 20 into a string, an error occurs." 21 (declare (explicit-check)) 22 (cond ((stringp x) x) 23 ((symbolp x) (symbol-name x)) 24 ((characterp x) 25 (let ((res (make-string 1))) 26 (setf (schar res 0) x) res)) 27 (t 28 (error 'simple-type-error 29 :datum x 30 :expected-type 'string-designator 31 :format-control "~S is not a string designator." 32 :format-arguments (list x))))) 33 34;;; %CHECK-VECTOR-SEQUENCE-BOUNDS is used to verify that the START and 35;;; END arguments are valid bounding indices. 36(defun %check-vector-sequence-bounds (vector start end) 37 (%check-vector-sequence-bounds vector start end)) 38 39(eval-when (:compile-toplevel) 40;;; WITH-ONE-STRING is used to set up some string hacking things. The 41;;; keywords are parsed, and the string is hacked into a 42;;; simple-string. 43(sb!xc:defmacro with-one-string ((string start end) &body forms) 44 `(let ((,string (%string ,string))) 45 (with-array-data ((,string ,string) 46 (,start ,start) 47 (,end ,end) 48 :check-fill-pointer t) 49 ,@forms))) 50;;; WITH-TWO-STRINGS is used to set up string comparison operations. The 51;;; keywords are parsed, and the strings are hacked into SIMPLE-STRINGs. 52(sb!xc:defmacro with-two-strings (string1 string2 start1 end1 cum-offset-1 53 start2 end2 &rest forms) 54 `(let ((,string1 (%string ,string1)) 55 (,string2 (%string ,string2))) 56 (with-array-data ((,string1 ,string1 :offset-var ,cum-offset-1) 57 (,start1 ,start1) 58 (,end1 ,end1) 59 :check-fill-pointer t) 60 (with-array-data ((,string2 ,string2) 61 (,start2 ,start2) 62 (,end2 ,end2) 63 :check-fill-pointer t) 64 ,@forms)))) 65 66(sb!xc:defmacro with-two-arg-strings (string1 string2 start1 end1 cum-offset-1 67 start2 end2 &rest forms) 68 `(let ((,string1 (%string ,string1)) 69 (,string2 (%string ,string2))) 70 (with-array-data ((,string1 ,string1 :offset-var ,cum-offset-1) 71 (,start1) 72 (,end1) 73 :check-fill-pointer t) 74 (with-array-data ((,string2 ,string2) 75 (,start2) 76 (,end2) 77 :check-fill-pointer t) 78 ,@forms)))) 79 80) ; EVAL-WHEN 81 82(defun char (string index) 83 #!+sb-doc 84 "Given a string and a non-negative integer index less than the length of 85 the string, returns the character object representing the character at 86 that position in the string." 87 (declare (optimize (safety 1))) 88 (char string index)) 89 90(defun %charset (string index new-el) 91 (declare (optimize (safety 1))) 92 (setf (char string index) new-el)) 93 94(defun schar (string index) 95 #!+sb-doc 96 "SCHAR returns the character object at an indexed position in a string 97 just as CHAR does, except the string must be a simple-string." 98 (declare (optimize (safety 1))) 99 (schar string index)) 100 101(defun %scharset (string index new-el) 102 (declare (optimize (safety 1))) 103 (setf (schar string index) new-el)) 104 105(defun string=* (string1 string2 start1 end1 start2 end2) 106 (declare (optimize speed)) 107 (with-two-strings string1 string2 start1 end1 nil start2 end2 108 (let ((len (- end1 start1))) 109 (unless (= len (- end2 start2)) ; trivial 110 (return-from string=* nil)) 111 ;; Optimizing the non-unicode builds is not terribly important 112 ;; because no per-character test for base/UCS4 is needed. 113 #!+sb-unicode 114 (let* ((widetag1 (%other-pointer-widetag string1)) 115 (widetag2 (%other-pointer-widetag string2)) 116 (char-shift 117 #!+(or x86 x86-64) 118 ;; The cost of WITH-PINNED-OBJECTS is near nothing on x86, 119 ;; and memcmp() is much faster except below a cutoff point. 120 ;; The threshold is higher on x86-32 because the overhead 121 ;; of a foreign call is higher due to FPU stack save/restore. 122 (if (and (= widetag1 widetag2) 123 (>= len #!+x86 16 124 #!+x86-64 8)) 125 (case widetag1 126 (#.sb!vm:simple-base-string-widetag 0) 127 (#.sb!vm:simple-character-string-widetag 2))))) 128 (when char-shift 129 (return-from string=* 130 ;; Efficiently compute byte indices. Derive-type on ASH isn't 131 ;; good enough. For 32-bit, it should be ok because 132 ;; (TYPEP (ASH ARRAY-TOTAL-SIZE-LIMIT 2) 'SB-VM:SIGNED-WORD) => T 133 ;; For 63-bit fixnums, that's false in theory, but true in practice. 134 ;; ARRAY-TOTAL-SIZE-LIMIT is too large for a 48-bit address space. 135 (macrolet ((sap (string start) 136 `(sap+ (vector-sap (truly-the string ,string)) 137 (scale ,start))) 138 (scale (index) 139 `(truly-the sb!vm:signed-word 140 (ash (truly-the index ,index) char-shift)))) 141 (declare (optimize (sb!c:alien-funcall-saves-fp-and-pc 0))) 142 (with-pinned-objects (string1 string2) 143 (zerop (alien-funcall 144 (extern-alien "memcmp" 145 (function int (* char) (* char) long)) 146 (sap string1 start1) (sap string2 start2) 147 (scale len))))))) 148 (macrolet 149 ((char-loop (type1 type2) 150 `(return-from string=* 151 (let ((string1 (truly-the (simple-array ,type1 1) string1)) 152 (string2 (truly-the (simple-array ,type2 1) string2))) 153 (declare (optimize (sb!c::insert-array-bounds-checks 0))) 154 (do ((index1 start1 (1+ index1)) 155 (index2 start2 (1+ index2))) 156 ((>= index1 end1) t) 157 (declare (index index1 index2)) 158 (unless (char= (schar string1 index1) 159 (schar string2 index2)) 160 (return nil))))))) 161 ;; On x86-64, short strings with same widetag use the general case. 162 ;; Why not always have cases for equal widetags and short strings? 163 ;; Because the code below deals with comparison when memcpy _can't_ 164 ;; be used and is essential to this logic. No major speed gain is had 165 ;; with extra cases where memcpy would do, but was avoided. 166 ;; On non-x86, Lisp code is used always because I did not profile 167 ;; memcmp(), and this code is at least as good as %SP-STRING-COMPARE. 168 ;; Also, (ARRAY NIL) always punts. 169 (cond #!-x86-64 170 ((= widetag1 widetag2) 171 (case widetag1 172 (#.sb!vm:simple-base-string-widetag 173 (char-loop base-char base-char)) 174 (#.sb!vm:simple-character-string-widetag 175 (char-loop character character)))) 176 ((or (and (= widetag1 sb!vm:simple-character-string-widetag) 177 (= widetag2 sb!vm:simple-base-string-widetag)) 178 (and (= widetag2 sb!vm:simple-character-string-widetag) 179 (= widetag1 sb!vm:simple-base-string-widetag) 180 (progn (rotatef start1 start2) 181 (rotatef end1 end2) 182 (rotatef string1 string2) 183 t))) 184 (char-loop character base-char)))))) 185 (not (%sp-string-compare string1 start1 end1 string2 start2 end2)))) 186 187(defun string/=* (string1 string2 start1 end1 start2 end2) 188 (with-two-strings string1 string2 start1 end1 offset1 start2 end2 189 (let ((comparison (%sp-string-compare string1 start1 end1 190 string2 start2 end2))) 191 (if comparison (- (the fixnum comparison) offset1))))) 192 193(eval-when (:compile-toplevel :execute) 194 195;;; LESSP is true if the desired expansion is for STRING<* or STRING<=*. 196;;; EQUALP is true if the desired expansion is for STRING<=* or STRING>=*. 197(sb!xc:defmacro string<>=*-body (lessp equalp) 198 (let ((offset1 (gensym))) 199 `(with-two-strings string1 string2 start1 end1 ,offset1 start2 end2 200 (let ((index (%sp-string-compare string1 start1 end1 201 string2 start2 end2))) 202 (if index 203 (cond ((= (the fixnum index) (the fixnum end1)) 204 ,(if lessp 205 `(- (the fixnum index) ,offset1) 206 `nil)) 207 ((= (+ (the fixnum index) (- start2 start1)) 208 (the fixnum end2)) 209 ,(if lessp 210 `nil 211 `(- (the fixnum index) ,offset1))) 212 ((,(if lessp 'char< 'char>) 213 (schar string1 index) 214 (schar string2 (+ (the fixnum index) (- start2 start1)))) 215 (- (the fixnum index) ,offset1)) 216 (t nil)) 217 ,(if equalp `(- (the fixnum end1) ,offset1) nil)))))) 218) ; EVAL-WHEN 219 220(defun string<* (string1 string2 start1 end1 start2 end2) 221 (declare (fixnum start1 start2)) 222 (string<>=*-body t nil)) 223 224(defun string>* (string1 string2 start1 end1 start2 end2) 225 (declare (fixnum start1 start2)) 226 (string<>=*-body nil nil)) 227 228(defun string<=* (string1 string2 start1 end1 start2 end2) 229 (declare (fixnum start1 start2)) 230 (string<>=*-body t t)) 231 232(defun string>=* (string1 string2 start1 end1 start2 end2) 233 (declare (fixnum start1 start2)) 234 (string<>=*-body nil t)) 235 236(defun string< (string1 string2 &key (start1 0) end1 (start2 0) end2) 237 #!+sb-doc 238 "Given two strings, if the first string is lexicographically less than 239 the second string, returns the longest common prefix (using char=) 240 of the two strings. Otherwise, returns ()." 241 (string<* string1 string2 start1 end1 start2 end2)) 242 243(defun two-arg-string< (string1 string2) 244 (string<* string1 string2 0 nil 0 nil)) 245 246(defun string> (string1 string2 &key (start1 0) end1 (start2 0) end2) 247 #!+sb-doc 248 "Given two strings, if the first string is lexicographically greater than 249 the second string, returns the longest common prefix (using char=) 250 of the two strings. Otherwise, returns ()." 251 (string>* string1 string2 start1 end1 start2 end2)) 252 253(defun two-arg-string> (string1 string2) 254 (string>* string1 string2 0 nil 0 nil)) 255 256(defun string<= (string1 string2 &key (start1 0) end1 (start2 0) end2) 257 #!+sb-doc 258 "Given two strings, if the first string is lexicographically less than 259 or equal to the second string, returns the longest common prefix 260 (using char=) of the two strings. Otherwise, returns ()." 261 (string<=* string1 string2 start1 end1 start2 end2)) 262 263(defun two-arg-string<= (string1 string2) 264 (string<=* string1 string2 0 nil 0 nil)) 265 266(defun string>= (string1 string2 &key (start1 0) end1 (start2 0) end2) 267 #!+sb-doc 268 "Given two strings, if the first string is lexicographically greater 269 than or equal to the second string, returns the longest common prefix 270 (using char=) of the two strings. Otherwise, returns ()." 271 (string>=* string1 string2 start1 end1 start2 end2)) 272 273(defun two-arg-string>= (string1 string2) 274 (string>=* string1 string2 0 nil 0 nil)) 275 276;;; Note: (STRING= "PREFIX" "SHORT" :END2 (LENGTH "PREFIX")) gives 277;;; an error instead of returning NIL as I would have expected. 278;;; The ANSI spec for STRING= itself doesn't seem to clarify this 279;;; much, but the SUBSEQ-OUT-OF-BOUNDS writeup seems to say that 280;;; this is conforming (and required) behavior, because any index 281;;; out of range is an error. (So there seems to be no concise and 282;;; efficient way to test for strings which begin with a particular 283;;; pattern. Alas..) -- WHN 19991206 284(defun string= (string1 string2 &key (start1 0) end1 (start2 0) end2) 285 #!+sb-doc 286 "Given two strings (string1 and string2), and optional integers start1, 287 start2, end1 and end2, compares characters in string1 to characters in 288 string2 (using char=)." 289 (string=* string1 string2 start1 end1 start2 end2)) 290 291(defun two-arg-string= (string1 string2) 292 (string=* string1 string2 0 nil 0 nil)) 293 294(defun string/= (string1 string2 &key (start1 0) end1 (start2 0) end2) 295 #!+sb-doc 296 "Given two strings, if the first string is not lexicographically equal 297 to the second string, returns the longest common prefix (using char=) 298 of the two strings. Otherwise, returns ()." 299 (string/=* string1 string2 start1 end1 start2 end2)) 300 301(defun two-arg-string/= (string1 string2) 302 (string/=* string1 string2 0 nil 0 nil)) 303 304(eval-when (:compile-toplevel :execute) 305 306;;; STRING-NOT-EQUAL-LOOP is used to generate character comparison loops for 307;;; STRING-EQUAL and STRING-NOT-EQUAL. 308(sb!xc:defmacro string-not-equal-loop (end 309 end-value 310 &optional (abort-value nil abortp)) 311 (declare (fixnum end)) 312 (let ((end-test (if (= end 1) 313 `(= index1 (the fixnum end1)) 314 `(= index2 (the fixnum end2))))) 315 `(locally (declare (inline two-arg-char-equal)) 316 (do ((index1 start1 (1+ index1)) 317 (index2 start2 (1+ index2))) 318 (,(if abortp 319 end-test 320 `(or ,end-test 321 (not (char-equal (schar string1 index1) 322 (schar string2 index2))))) 323 ,end-value) 324 (declare (fixnum index1 index2)) 325 ,@(if abortp 326 `((if (not (char-equal (schar string1 index1) 327 (schar string2 index2))) 328 (return ,abort-value)))))))) 329 330) ; EVAL-WHEN 331 332(defun string-equal (string1 string2 &key (start1 0) end1 (start2 0) end2) 333 #!+sb-doc 334 "Given two strings (string1 and string2), and optional integers start1, 335 start2, end1 and end2, compares characters in string1 to characters in 336 string2 (using char-equal)." 337 (declare (fixnum start1 start2)) 338 (with-two-strings string1 string2 start1 end1 nil start2 end2 339 (let ((slen1 (- (the fixnum end1) start1)) 340 (slen2 (- (the fixnum end2) start2))) 341 (declare (fixnum slen1 slen2)) 342 (when (= slen1 slen2) 343 ;;return NIL immediately if lengths aren't equal. 344 (string-not-equal-loop 1 t nil))))) 345 346(defun two-arg-string-equal (string1 string2) 347 (with-two-arg-strings string1 string2 start1 end1 nil start2 end2 348 (let ((slen1 (- (the fixnum end1) start1)) 349 (slen2 (- (the fixnum end2) start2))) 350 (declare (fixnum slen1 slen2)) 351 (when (= slen1 slen2) 352 (string-not-equal-loop 1 t nil))))) 353 354(defun string-not-equal (string1 string2 &key (start1 0) end1 (start2 0) end2) 355 #!+sb-doc 356 "Given two strings, if the first string is not lexicographically equal 357 to the second string, returns the longest common prefix (using char-equal) 358 of the two strings. Otherwise, returns ()." 359 (with-two-strings string1 string2 start1 end1 offset1 start2 end2 360 (let ((slen1 (- end1 start1)) 361 (slen2 (- end2 start2))) 362 (declare (fixnum slen1 slen2)) 363 (cond ((= slen1 slen2) 364 (string-not-equal-loop 1 nil (- index1 offset1))) 365 ((< slen1 slen2) 366 (string-not-equal-loop 1 (- index1 offset1))) 367 (t 368 (string-not-equal-loop 2 (- index1 offset1))))))) 369 370(defun two-arg-string-not-equal (string1 string2) 371 (with-two-arg-strings string1 string2 start1 end1 offset1 start2 end2 372 (let ((slen1 (- end1 start1)) 373 (slen2 (- end2 start2))) 374 (declare (fixnum slen1 slen2)) 375 (cond ((= slen1 slen2) 376 (string-not-equal-loop 1 nil (- index1 offset1))) 377 ((< slen1 slen2) 378 (string-not-equal-loop 1 (- index1 offset1))) 379 (t 380 (string-not-equal-loop 2 (- index1 offset1))))))) 381 382(eval-when (:compile-toplevel :execute) 383 384;;; STRING-LESS-GREATER-EQUAL-TESTS returns a test on the lengths of string1 385;;; and string2 and a test on the current characters from string1 and string2 386;;; for the following macro. 387(defun string-less-greater-equal-tests (lessp equalp) 388 (if lessp 389 (if equalp 390 ;; STRING-NOT-GREATERP 391 (values '<= `(not (char-greaterp char1 char2))) 392 ;; STRING-LESSP 393 (values '< `(char-lessp char1 char2))) 394 (if equalp 395 ;; STRING-NOT-LESSP 396 (values '>= `(not (char-lessp char1 char2))) 397 ;; STRING-GREATERP 398 (values '> `(char-greaterp char1 char2))))) 399 400(sb!xc:defmacro string-less-greater-equal (lessp equalp) 401 (multiple-value-bind (length-test character-test) 402 (string-less-greater-equal-tests lessp equalp) 403 `(locally (declare (inline two-arg-char-equal)) 404 (with-two-strings string1 string2 start1 end1 offset1 start2 end2 405 (let ((slen1 (- (the fixnum end1) start1)) 406 (slen2 (- (the fixnum end2) start2))) 407 (declare (fixnum slen1 slen2)) 408 (do ((index1 start1 (1+ index1)) 409 (index2 start2 (1+ index2)) 410 (char1) 411 (char2)) 412 ((or (= index1 (the fixnum end1)) (= index2 (the fixnum end2))) 413 (if (,length-test slen1 slen2) (- index1 offset1))) 414 (declare (fixnum index1 index2)) 415 (setq char1 (schar string1 index1)) 416 (setq char2 (schar string2 index2)) 417 (if (not (char-equal char1 char2)) 418 (if ,character-test 419 (return (- index1 offset1)) 420 (return ()))))))))) 421 422) ; EVAL-WHEN 423 424(defun string-lessp* (string1 string2 start1 end1 start2 end2) 425 (declare (fixnum start1 start2)) 426 (string-less-greater-equal t nil)) 427 428(defun string-greaterp* (string1 string2 start1 end1 start2 end2) 429 (declare (fixnum start1 start2)) 430 (string-less-greater-equal nil nil)) 431 432(defun string-not-lessp* (string1 string2 start1 end1 start2 end2) 433 (declare (fixnum start1 start2)) 434 (string-less-greater-equal nil t)) 435 436(defun string-not-greaterp* (string1 string2 start1 end1 start2 end2) 437 (declare (fixnum start1 start2)) 438 (string-less-greater-equal t t)) 439 440(defun string-lessp (string1 string2 &key (start1 0) end1 (start2 0) end2) 441 #!+sb-doc 442 "Given two strings, if the first string is lexicographically less than 443 the second string, returns the longest common prefix (using char-equal) 444 of the two strings. Otherwise, returns ()." 445 (string-lessp* string1 string2 start1 end1 start2 end2)) 446 447(defun two-arg-string-lessp (string1 string2) 448 (string-lessp* string1 string2 0 nil 0 nil)) 449 450(defun string-greaterp (string1 string2 &key (start1 0) end1 (start2 0) end2) 451 #!+sb-doc 452 "Given two strings, if the first string is lexicographically greater than 453 the second string, returns the longest common prefix (using char-equal) 454 of the two strings. Otherwise, returns ()." 455 (string-greaterp* string1 string2 start1 end1 start2 end2)) 456 457(defun two-arg-string-greaterp (string1 string2) 458 (string-greaterp* string1 string2 0 nil 0 nil)) 459 460(defun string-not-lessp (string1 string2 &key (start1 0) end1 (start2 0) end2) 461 #!+sb-doc 462 "Given two strings, if the first string is lexicographically greater 463 than or equal to the second string, returns the longest common prefix 464 (using char-equal) of the two strings. Otherwise, returns ()." 465 (string-not-lessp* string1 string2 start1 end1 start2 end2)) 466 467(defun two-arg-string-not-lessp (string1 string2) 468 (string-not-lessp* string1 string2 0 nil 0 nil)) 469 470(defun string-not-greaterp (string1 string2 &key (start1 0) end1 (start2 0) 471 end2) 472 #!+sb-doc 473 "Given two strings, if the first string is lexicographically less than 474 or equal to the second string, returns the longest common prefix 475 (using char-equal) of the two strings. Otherwise, returns ()." 476 (string-not-greaterp* string1 string2 start1 end1 start2 end2)) 477 478 479(defun two-arg-string-not-greaterp (string1 string2) 480 (string-not-greaterp* string1 string2 0 nil 0 nil)) 481 482(defun make-string (count &key 483 (element-type 'character) 484 ((:initial-element fill-char))) 485 #!+sb-doc 486 "Given a character count and an optional fill character, makes and returns a 487new string COUNT long filled with the fill character." 488 (declare (index count)) 489 (declare (explicit-check)) 490 ;; FIXME: while this is a correct implementation relying on an IR1 transform, 491 ;; it would be better if in the following example (assuming NOTINLINE): 492 ;; (MAKE-STRING 1000 :ELEMENT-TYPE 'BIT :INITIAL-element #\a) 493 ;; we could report that "BIT is not a subtype of CHARACTER" 494 ;; instead of "#\a is not of type BIT". Additionally, in this case: 495 ;; (MAKE-STRING 200000000 :ELEMENT-TYPE 'WORD :INITIAL-ELEMENT #\a) 496 ;; the error reported is heap exhaustion rather than type mismatch. 497 (if fill-char 498 (make-string count :element-type element-type 499 :initial-element (the character fill-char)) 500 (make-string count :element-type element-type))) 501 502(flet ((%upcase (string start end) 503 (declare (string string) (index start) (type sequence-end end)) 504 (let ((saved-header string)) 505 (with-one-string (string start end) 506 (do ((index start (1+ index))) 507 ((= index (the fixnum end))) 508 (declare (fixnum index)) 509 (setf (schar string index) (char-upcase (schar string index))))) 510 saved-header))) 511(defun string-upcase (string &key (start 0) end) 512 (%upcase (copy-seq (string string)) start end)) 513(defun nstring-upcase (string &key (start 0) end) 514 (%upcase string start end)) 515) ; FLET 516 517(flet ((%downcase (string start end) 518 (declare (string string) (index start) (type sequence-end end)) 519 (let ((saved-header string)) 520 (with-one-string (string start end) 521 (do ((index start (1+ index))) 522 ((= index (the fixnum end))) 523 (declare (fixnum index)) 524 (setf (schar string index) 525 (char-downcase (schar string index))))) 526 saved-header))) 527(defun string-downcase (string &key (start 0) end) 528 (%downcase (copy-seq (string string)) start end)) 529(defun nstring-downcase (string &key (start 0) end) 530 (%downcase string start end)) 531) ; FLET 532(flet ((%capitalize (string start end) 533 (declare (string string) (index start) (type sequence-end end)) 534 (let ((saved-header string)) 535 (with-one-string (string start end) 536 (do ((index start (1+ index)) 537 (new-word? t) 538 (char nil)) 539 ((= index (the fixnum end))) 540 (declare (fixnum index)) 541 (setq char (schar string index)) 542 (cond ((not (alphanumericp char)) 543 (setq new-word? t)) 544 (new-word? 545 ;; CHAR is the first case-modifiable character after 546 ;; a sequence of non-case-modifiable characters. 547 (setf (schar string index) (char-upcase char)) 548 (setq new-word? nil)) 549 (t 550 (setf (schar string index) (char-downcase char)))))) 551 saved-header))) 552 (defun string-capitalize (string &key (start 0) end) 553 (%capitalize (copy-seq (string string)) start end)) 554 (defun nstring-capitalize (string &key (start 0) end) 555 (%capitalize string start end)) 556 ) ; FLET 557 558 559(defun generic-string-trim (char-bag string left-p right-p) 560 (let ((header (%string string))) 561 (with-array-data ((string header) 562 (start) 563 (end) 564 :check-fill-pointer t) 565 (let* ((left-end (if left-p 566 (do ((index start (1+ index))) 567 ((or (= index (the fixnum end)) 568 (not (find (schar string index) 569 char-bag 570 :test #'char=))) 571 index) 572 (declare (fixnum index))) 573 start)) 574 (right-end (if right-p 575 (do ((index (1- (the fixnum end)) (1- index))) 576 ((or (< index left-end) 577 (not (find (schar string index) 578 char-bag 579 :test #'char=))) 580 (1+ index)) 581 (declare (fixnum index))) 582 end))) 583 (if (and (eql left-end start) 584 (eql right-end end)) 585 header 586 (subseq (the simple-string string) left-end right-end)))))) 587 588(defun string-left-trim (char-bag string) 589 (generic-string-trim char-bag string t nil)) 590 591(defun string-right-trim (char-bag string) 592 (generic-string-trim char-bag string nil t)) 593 594(defun string-trim (char-bag string) 595 (generic-string-trim char-bag string t t)) 596