X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fseq.lisp;h=f63ce3b546eb01bd8d0072d38a7fc3597d7940bf;hb=95591ed483dbb8c0846c129953acac1554f28809;hp=c76c58673d955f7675657c0450e2170152b4295f;hpb=6822034325136cde4e14773c83c3769b42721306;p=sbcl.git

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index c76c586..f63ce3b 100644
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -520,22 +520,18 @@
                     (end end)
                     :force-inline t
                     :check-fill-pointer t)
-    (macrolet ((frob ()
-                 `(locally (declare (optimize (safety 0) (speed 3)))
-                    (do ((i start (1+ i)))
-                        ((= i end) sequence)
-                     (declare (index i))
-                     (setf (aref data i) item)))))
-      (etypecase data
-        #!+sb-unicode
-        ((simple-array character (*))
-         (let ((item (locally (declare (optimize (safety 3)))
-                       (the character item))))
-           (frob)))
-        ((simple-array base-char (*))
-         (let ((item (locally (declare (optimize (safety 3)))
-                       (the base-char item))))
-           (frob)))))))
+    ;; DEFTRANSFORM for FILL will turn these into
+    ;; calls to UB*-BASH-FILL.
+    (etypecase data
+      #!+sb-unicode
+      ((simple-array character (*))
+       (let ((item (locally (declare (optimize (safety 3)))
+                     (the character item))))
+         (fill data item :start start :end end)))
+      ((simple-array base-char (*))
+       (let ((item (locally (declare (optimize (safety 3)))
+                     (the base-char item))))
+         (fill data item :start start :end end))))))
 
 (defun fill (sequence item &key (start 0) end)
   #!+sb-doc
@@ -870,6 +866,29 @@
     (t
      (bad-sequence-type-error output-type-spec)))))
 
+;;; Efficient out-of-line concatenate for strings. Compiler transforms
+;;; CONCATENATE 'STRING &co into these.
+(macrolet ((def (name element-type)
+             `(defun ,name (&rest sequences)
+                (declare (dynamic-extent sequences)
+                         (optimize speed))
+                (let* ((lengths (mapcar #'length sequences))
+                       (result (make-array (the integer (apply #'+ lengths))
+                                           :element-type ',element-type))
+                       (start 0))
+                  (declare (index start))
+                  (dolist (seq sequences)
+                    (string-dispatch
+                        ((simple-array character (*))
+                         (simple-array base-char (*))
+                         t)
+                        seq
+                      (replace result seq :start1 start))
+                    (incf start (the index (pop lengths))))
+                  result))))
+  (def %concatenate-to-string character)
+  (def %concatenate-to-base-string base-char))
+
 ;;; internal frobs
 ;;; FIXME: These are weird. They're never called anywhere except in
 ;;; CONCATENATE. It seems to me that the macros ought to just