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