From: Juho S. <js...@us...> - 2007-12-10 05:35:28
|
Update of /cvsroot/sbcl/sbcl/src/code In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv16448/src/code Modified Files: string.lisp Log Message: 1.0.12.23: Optimize STRING-*-TRIM * Add deftransforms for STRING(-LEFT|-RIGHT|)-TRIM of simple strings. As a sleazy benchmark trick, also optimize for constant character bags. * Rewrite the function versions of the string trimmers for more code reuse. New versions also no longer cons up a new string when no trimming needs to be done. (Allowed in the spec, as pointed out by Attila Lendvai) * Add tests. Index: string.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/string.lisp,v retrieving revision 1.14 retrieving revision 1.15 diff -u -d -r1.14 -r1.15 --- string.lisp 5 Dec 2007 15:16:02 -0000 1.14 +++ string.lisp 10 Dec 2007 05:35:11 -0000 1.15 @@ -404,36 +404,36 @@ (%capitalize string start end)) ) ; FLET -(defun string-left-trim (char-bag string) +(defun generic-string-trim (char-bag string left-p right-p) (with-string string - (do ((index start (1+ index))) - ((or (= index (the fixnum end)) - (not (find (schar string index) char-bag :test #'char=))) - (subseq (the simple-string string) index end)) - (declare (fixnum index))))) + (let* ((left-end (if left-p + (do ((index start (1+ index))) + ((or (= index (the fixnum end)) + (not (find (schar string index) + char-bag + :test #'char=))) + index) + (declare (fixnum index))) + 0)) + (right-end (if right-p + (do ((index (1- (the fixnum end)) (1- index))) + ((or (< index left-end) + (not (find (schar string index) + char-bag + :test #'char=))) + (1+ index)) + (declare (fixnum index))) + (length string)))) + (if (and (eql left-end 0) + (eql right-end (length string))) + string + (subseq (the simple-string string) left-end right-end))))) + +(defun string-left-trim (char-bag string) + (generic-string-trim char-bag string t nil)) (defun string-right-trim (char-bag string) - (with-string string - (do ((index (1- (the fixnum end)) (1- index))) - ((or (< index start) - (not (find (schar string index) char-bag :test #'char=))) - (subseq (the simple-string string) start (1+ index))) - (declare (fixnum index))))) + (generic-string-trim char-bag string nil t)) (defun string-trim (char-bag string) - (with-string string - (let* ((left-end (do ((index start (1+ index))) - ((or (= index (the fixnum end)) - (not (find (schar string index) - char-bag - :test #'char=))) - index) - (declare (fixnum index)))) - (right-end (do ((index (1- (the fixnum end)) (1- index))) - ((or (< index left-end) - (not (find (schar string index) - char-bag - :test #'char=))) - (1+ index)) - (declare (fixnum index))))) - (subseq (the simple-string string) left-end right-end)))) + (generic-string-trim char-bag string t t)) |