[flexichain-cvs] CVS update: flexichain/flexichain.lisp

[Robert Strandh]

Update of /project/flexichain/cvsroot/flexichain
In directory cl-net:/tmp/cvs-serv21178

Modified Files:
	flexichain.lisp 
Log Message:
Used REPLACE to implement insert-vector*.

Thanks to Cyrus Harmon for this improvement.

Date: Tue Oct  5 01:05:06 2010
Author: rstrandh

Index: flexichain/flexichain.lisp
diff -u flexichain/flexichain.lisp:1.9 flexichain/flexichain.lisp:1.10
--- flexichain/flexichain.lisp:1.9	Sun Oct  3 05:29:19 2010
+++ flexichain/flexichain.lisp	Tue Oct  5 01:05:06 2010
@@ -247,26 +247,30 @@
 
 (defmethod insert* ((chain standard-flexichain) position object)
   (with-slots (buffer gap-start) chain
-     (assert (<= 0 position (nb-elements chain)) ()
-             'flexi-position-error :chain chain :position position)
-     (ensure-gap-position chain position)
-     (ensure-room chain (1+ (nb-elements chain)))
-     (setf (aref buffer gap-start) object)
-     (incf gap-start)
-     (when (= gap-start (length buffer))
-       (setf gap-start 0))))
+    (assert (<= 0 position (nb-elements chain)) ()
+	    'flexi-position-error :chain chain :position position)
+    (ensure-gap-position chain position)
+    (ensure-room chain (1+ (nb-elements chain)))
+    (setf (aref buffer gap-start) object)
+    (incf gap-start)
+    (when (= gap-start (length buffer))
+      (setf gap-start 0))))
   
 (defmethod insert-vector* ((chain standard-flexichain) position vector)
   (with-slots (buffer gap-start) chain
-     (assert (<= 0 position (nb-elements chain)) ()
+    (assert (<= 0 position (nb-elements chain)) ()
              'flexi-position-error :chain chain :position position)
-     (ensure-gap-position chain position)
-     (ensure-room chain (+ (nb-elements chain) (length vector)))
-     (loop for elem across vector
-        do (setf (aref buffer gap-start) elem)
-          (incf gap-start)
-          (when (= gap-start (length buffer))
-            (setf gap-start 0)))))
+    (ensure-gap-position chain position)
+    (ensure-room chain (+ (nb-elements chain) (length vector)))
+    (if (>= (+ gap-start (length vector)) (length buffer))
+	(progn
+	  (replace buffer vector :start1 gap-start :end1 (length buffer))
+	  (replace buffer vector
+		   :start2 (- (length buffer) gap-start))
+	  (setf gap-start (- (length vector) (- (length buffer) gap-start))))
+	(progn
+	  (replace buffer vector :start1 gap-start :end1 (+ gap-start (length vector)))
+	  (incf gap-start (length vector))))))
   
 (defmethod delete* ((chain standard-flexichain) position)
   (with-slots (buffer expand-factor min-size fill-element gap-end) chain