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)