[Lisppaste-cvs] CVS update: lisppaste2/encode-for-pre.lisp

[Brian Mastenbrook]

Update of /project/lisppaste/cvsroot/lisppaste2
In directory common-lisp.net:/tmp/cvs-serv19766

Modified Files:
	encode-for-pre.lisp 
Log Message:
Further optimization

Date: Sun Nov 30 17:32:45 2003
Author: bmastenbrook

Index: lisppaste2/encode-for-pre.lisp
diff -u lisppaste2/encode-for-pre.lisp:1.5 lisppaste2/encode-for-pre.lisp:1.6
--- lisppaste2/encode-for-pre.lisp:1.5	Sun Nov 30 17:16:45 2003
+++ lisppaste2/encode-for-pre.lisp	Sun Nov 30 17:32:45 2003
@@ -1,23 +1,32 @@
-;;;; $Id: encode-for-pre.lisp,v 1.5 2003/11/30 22:16:45 bmastenbrook Exp $
+;;;; $Id: encode-for-pre.lisp,v 1.6 2003/11/30 22:32:45 bmastenbrook Exp $
 ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/encode-for-pre.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
 
 (in-package :lisppaste)
 
+(defun replace-in-string-1 (str char repstr)
+  (let* ((new-length (loop for i from 0 to (1- (length str))
+			   summing (if (char= (elt str i) char)
+				       (length repstr) 1)))
+	 (new-array (make-array `(,new-length) :element-type 'character)))
+    (loop for i from 0 to (1- (length str))
+	  with j = 0
+	  do (if (char= (elt str i) char)
+		 (progn
+		   (loop for k from 0 to (1- (length repstr))
+			 do (setf (elt new-array (+ j k)) (elt repstr k)))
+		   (incf j (length repstr)))
+		 (progn
+		   (setf (elt new-array j) (elt str i))
+		   (incf j))))
+    new-array))
+
 (defun replace-in-string (str chars repstrs)
   (declare (type string str))
   (let ((stri str))
     (loop for char in chars for repstr in repstrs do
-	  (let ((startpos 0))
-	    (tagbody
-	     start
-	       (let ((pos (position char stri :test #'char= :start startpos)))
-		 (when pos
-		   (setf stri (concatenate 'string (subseq stri 0 pos) repstr (subseq stri (1+ pos) (length stri))))
-		   (setf startpos (+ pos (length repstr)))
-		   (go start))))
-	    stri))
+	  (setf stri (replace-in-string-1 stri char repstr)))
     stri))
 
 (defun encode-for-pre (str)