From 14c4175c209f5e08311800af97408f2dc723765a Mon Sep 17 00:00:00 2001
From: Attila Lendvai <attila.lendvai@gmail.com>
Date: Wed, 30 Sep 2009 16:04:14 +0200
Subject: [PATCH] some care for replace.lisp, notably get rid of the single usage of iterate


diff --git a/cl-irregsexp.asd b/cl-irregsexp.asd
index 5d2c4d5..44fcc53 100644
--- a/cl-irregsexp.asd
+++ b/cl-irregsexp.asd
@@ -26,8 +26,5 @@
 				     (:file "replace" :depends-on ("bind" "byte-vector"))
 				     (:file "split" :depends-on ("bind")))))
   :depends-on (
-	       :iterate
-	       :alexandria))
-
-
-			
+               :alexandria
+               ))
diff --git a/src/replace.lisp b/src/replace.lisp
index 00b56e0..389ec8e 100644
--- a/src/replace.lisp
+++ b/src/replace.lisp
@@ -1,52 +1,62 @@
 (in-package #:cl-irregsexp)
 
-(defmacro match-replace-helper ( string &rest match-replacements)
-  (with-unique-names (before replacement-text after)
-    `(let (,replacement-text)
-       (if-match-bind (,before (or 
-				,@(loop for (match replacement) in match-replacements
-					collect `(progn ,match '(setf ,replacement-text (force-to-target-sequence ,replacement))))
-				(last))
-			       ,after)
-		      ,string
-		      (values ,before ,replacement-text ,after)
-		      nil))))
-
-(defun-speedy concat-byte-vector (seqs)
-  (cond ((rest seqs)
-	 (let ((len (loop for s in seqs summing (length (the byte-vector s)))))
-	   (let ((ret (make-byte-vector len)) (i 0))
-	     (loop for a in seqs do (let ((s (force-simple-byte-vector a))) (replace ret s :start1 i) (incf i (length s))))
-	     ret)))
-	(t
-	 (force-byte-vector (first seqs)))))
-
-(defun-speedy concat-string (seqs)
-  (apply 'concatenate 'string seqs))
+(defun-speedy concatenate-sequences (prototype sequences)
+  (etypecase prototype
+    (string
+     (let ((*print-pretty* nil))
+       (with-output-to-string (out)
+         (dolist (el sequences)
+           (write-string el out)))))
+    (byte-vector
+     (cond
+       ((rest sequences)
+        (let ((len (loop
+                      :for s :in sequences
+                      :summing (length (the byte-vector s)))))
+          (let ((ret (make-byte-vector len)) (i 0))
+            (loop :for a :in sequences :do
+               (let ((s (force-simple-byte-vector a)))
+                 (replace ret s :start1 i)
+                 (incf i (length s))))
+            ret)))
+       (t
+        (force-byte-vector (first sequences)))))))
 
+(defmacro match-replace-helper (string &body match-replacements)
+  (with-unique-names (before replacement-text remaining)
+    `(let (,replacement-text)
+       (if-match-bind (,before (or ,@(loop
+                                        :for (match replacement) :in match-replacements
+                                        :collect `(progn
+                                                    ,match
+                                                    '(setf ,replacement-text (force-to-target-sequence ,replacement))))
+                                   (last))
+                               ,remaining)
+                      ,string
+                      (values ,before ,replacement-text ,remaining)
+                      nil))))
 
-(defun-speedy concat (string seqs)
-  (etypecase string
-    (string (concat-string seqs))
-    (byte-vector (concat-byte-vector seqs))))
-
-(defmacro match-replace-one (string &rest match-replacements)
+(defmacro match-replace-one (string &body match-replacements)
   "As match-replace-all but at most one replacement is made"
   (once-only (string)
-    `(concat ,string (multiple-value-list (match-replace-helper ,string ,@match-replacements)))))
+    `(concatenate-sequences ,string (multiple-value-list (match-replace-helper ,string ,@match-replacements)))))
 
-(defmacro match-replace-all (string &rest match-replacements)
+(defmacro match-replace-all (string &body match-replacements)
   "For each (match replacment) in MATCH-REPLACEMENTS replace each value of match with the value of replacement in STRING"
-  (with-unique-names (s b r a f)
-    `(let ((,s ,string))
-       (flet ((,f () ; move out of the iter:iter so we can use macrolet without warnings
-		(match-replace-helper ,s ,@match-replacements)))
-	 (declare (inline ,f))
-	 (concat ,s 
-		 (iter:iter 
-		   (multiple-value-bind (,b ,r ,a)
-		       (,f)
-		     (unless (zerop (length ,b)) (iter:collect ,b))
-		     (unless (zerop (length ,r)) (iter:collect ,r))
-		     (iter:until (zerop (length ,a)))
-		     (setf ,s ,a))))))))
+  (with-unique-names (result)
+    (once-only (string)
+      `(concatenate-sequences
+        ,string
+        (let ((,result nil))
+          (loop
+             (multiple-value-bind (before replacement remaining)
+                 (match-replace-helper ,string ,@match-replacements)
+               (unless (zerop (length before))
+                 (push before ,result))
+               (unless (zerop (length replacement))
+                 (push replacement ,result))
+               (when (zerop (length remaining))
+                 (return))
+               (setf ,string remaining)))
+          ;; OPTIMIZATION: this nreverse could be avoided, but it should be negligable compared to the rest
+          (nreverse ,result))))))
-- 
1.6.0.4