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

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index 7cc9692..f63ce3b 100644
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -866,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