add remove-char-string

[kmrcl.git] / strings.lisp

diff --git a/strings.lisp b/strings.lisp
index 1178b5d5426e24c727f804de200625d6d3e4ed02..9a9f42d8a354985df274ac5829ad0118b21e1eea 100644 (file)
--- a/strings.lisp
+++ b/strings.lisp
@@ -44,7 +44,6 @@
             (setq in-word t))
         (setq in-word nil)))))
 
-;; From Larry Hunter with modifications
 (defun position-char (char string start max)
   (declare (optimize (speed 3) (safety 0) (space 0))
            (fixnum start max) (simple-string string))
@@ -567,6 +566,23 @@ for characters in a string"
       str)))
 
 
+(defun remove-char-string (char str)
+  (declare (character char)
+           (string str))
+  (do* ((len (length str))
+        (out (make-string len))
+        (pos 0 (1+ pos))
+        (opos 0))
+       ((= pos len) (subseq out 0 opos))
+    (declare (fixnum pos opos len)
+             (simple-string out))
+    (let ((c (char str pos)))
+      (declare (character c))
+      (when (char/= c char)
+        (setf (schar out opos) c)
+        (incf opos)))))
+
+
 (defun string-strip-ending (str endings)
   (if (stringp endings)
       (setq endings (list endings)))