X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=strings.lisp;h=a6db99b655ddde6af58900eab8b8d289167a3bcf;hp=45c2d7a54ba27e5414a4b458de3990f4d6863a4e;hb=8d831065b8e830ea8b257aa7befd53bee7f49d5d;hpb=4de7f25a69c218303f170314ac26217770a531ed diff --git a/strings.lisp b/strings.lisp index 45c2d7a..a6db99b 100644 --- a/strings.lisp +++ b/strings.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: strings.lisp,v 1.10 2003/04/28 23:51:59 kevin Exp $ +;;;; $Id: strings.lisp,v 1.18 2003/05/05 19:54:14 kevin Exp $ ;;;; ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -18,7 +18,6 @@ (in-package :kmrcl) -(declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3))) ;;; Strings @@ -45,31 +44,50 @@ (setq in-word nil)))) n-words)) -#+excl -(defun delimited-string-to-list (string &optional (separator #\space)) +#+allegro +(defun delimited-string-to-list (string &optional (separator #\space) skip-terminal) + "Uses allegro's internal function since that benchmarks faster than +my algorithm. Does allegro use assembly?" + (declare (string string) (character separator)) + (when skip-terminal + (let ((len (length string))) + (when (and (plusp len) (char= separator (char string (1- len)))) + (setq string (subseq string 0 (1- len)))))) (excl:delimited-string-to-list string separator)) -#-excl -(defun delimited-string-to-list (sequence &optional (separator #\space)) - "Split a string by a delimitor" - (loop - with start = 0 - for end = (position separator sequence :start start) - collect (subseq sequence start end) - until (null end) - do - (setf start (1+ end)))) - -#+excl -(defun list-to-delimited-string (list &optional (separator #\space)) - (excl:list-to-delimited-string list separator)) +(defun #-allegro delimited-string-to-list + #+allegro my-delimited-string-to-list + (string &optional (separator #\space) skip-terminal) + "split a string with delimiter" + (declare (optimize (speed 3) (safety 0) (space 0) (compilation-speed 0)) + (type string string) + (type character separator)) + (do* ((len (length string)) + (output '()) + (pos 0) + (end (position separator string :start pos :end len) + (position separator string :start pos :end len)) + (previous nil)) + ((null end) + (cond + ((null previous) + (list string)) + (t + (incf previous) + (if (< previous len) + (push (subseq string previous) output) + (unless skip-terminal + (push "" output))) + (nreverse output)))) + (declare (type fixnum pos len) + (type (or null fixnum) end previous)) + (push (subseq string pos end) output) + (setq previous end) + (setq pos (1+ end)))) + -#-excl (defun list-to-delimited-string (list &optional (separator #\space)) - (if (consp list) - (let ((fmt (format nil "~~A~~{~A~~A~~}" separator))) - (format nil fmt (first list) (rest list))) - "")) + (format nil (format nil "~~{~~A~~^~A~~}" separator) list)) (defun string-invert (str) "Invert case of a string" @@ -90,7 +108,7 @@ (defun substitute-string-for-char (procstr match-char subst-str) "Substitutes a string for a single matching character of a string" - (replace-chars-strings procstr (list (cons match-char subst-str)))) + (substitute-chars-strings procstr (list (cons match-char subst-str)))) (defun string-substitute (string substring replacement-string) "String substitute by Larry Hunter. Obtained from Google" @@ -111,9 +129,17 @@ (defun string-trim-last-character (s) "Return the string less the last character" - (aif (plusp (length s)) - (subseq s 0 (1- it)) - s)) + (let ((len (length s))) + (if (plusp len) + (subseq s 0 (1- len)) + s))) + +(defun nstring-trim-last-character (s) + "Return the string less the last character" + (let ((len (length s))) + (if (plusp len) + (nsubseq s 0 (1- len)) + s))) (defun string-hash (str &optional (bitmask 65535)) (let ((hash 0)) @@ -129,8 +155,9 @@ (defun whitespace? (c) (declare (character c)) - (declare (optimize (speed 3) (safety 0))) - (or (char= c #\Space) (char= c #\Tab) (char= c #\Return) (char= c #\Linefeed))) + (locally (declare (optimize (speed 3) (safety 0))) + (or (char= c #\Space) (char= c #\Tab) (char= c #\Return) + (char= c #\Linefeed)))) (defun not-whitespace? (c) (not (whitespace? c))) @@ -154,7 +181,7 @@ (incf new-len (1- (length (cdr match))))))) new-len)) -(defun string-replace-chars-strings (str repl-alist) +(defun substitute-chars-strings (str repl-alist) "Replace all instances of a chars with a string. repl-alist is an assoc list of characters and replacement strings." (declare (simple-string str)) @@ -182,41 +209,9 @@ list of characters and replacement strings." (defun escape-xml-string (string) "Escape invalid XML characters" - (string-replace-chars-strings - string '((#\& . "&") (#\> . ">") (#\< . "<")))) - -(defun string-replace-char-string (string repl-char repl-str) - "Replace all occurances of repl-char with repl-str" - (declare (simple-string string)) - (let ((count (count repl-char string))) - (declare (fixnum count)) - (if (zerop count) - string - (locally (declare (optimize (speed 3) (safety 0))) - (let* ((old-length (length string)) - (repl-length (length repl-str)) - (new-string (make-string (the fixnum - (+ old-length - (the fixnum - (* count - (the fixnum (1- repl-length))))))))) - (declare (fixnum old-length repl-length) - (simple-string new-string)) - (let ((newpos 0)) - (declare (fixnum newpos)) - (dotimes (oldpos (length string)) - (declare (fixnum oldpos)) - (if (char= repl-char (schar string oldpos)) - (dotimes (repl-pos repl-length) - (declare (fixnum repl-pos)) - (setf (schar new-string newpos) (schar repl-str repl-pos)) - (incf newpos)) - (progn - (setf (schar new-string newpos) (schar string oldpos)) - (incf newpos))))) - new-string))))) - - + (substitute-chars-strings + string '((#\& . "&") (#\> . ">") (#\< . "<") (#\" . """)))) + (defun make-usb8-array (len) (make-array len :adjustable nil