X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fprimordial-extensions.lisp;h=d09a8b22294dcad516a1bd6e010b471c6f31955f;hb=35697e2c02e7b29f7953ae318d50305561927a16;hp=1ed66e784b0f3a8dbf34840f86b01e7e97ede3fb;hpb=75b52379bdc2269961af6a1308eca63610f38ac3;p=sbcl.git

diff --git a/src/code/primordial-extensions.lisp b/src/code/primordial-extensions.lisp
index 1ed66e7..d09a8b2 100644
--- a/src/code/primordial-extensions.lisp
+++ b/src/code/primordial-extensions.lisp
@@ -167,30 +167,15 @@
 ;;; producing a symbol in the current package.
 (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
   (defun symbolicate (&rest things)
-    (let ((name (case (length things)
-		  ;; Why isn't this just the value in the T branch?
-		  ;; Well, this is called early in cold-init, before
-		  ;; the type system is set up; however, now that we
-		  ;; check for bad lengths, the type system is needed
-		  ;; for calls to CONCATENATE. So we need to make sure
-		  ;; that the calls are transformed away:
-		  (1 (concatenate 'string
-				  (the simple-base-string
-				    (string (car things)))))
-		  (2 (concatenate 'string 
-				  (the simple-base-string
-				    (string (car things)))
-				  (the simple-base-string
-				    (string (cadr things)))))
-		  (3 (concatenate 'string
-				  (the simple-base-string
-				    (string (car things)))
-				  (the simple-base-string
-				    (string (cadr things)))
-				  (the simple-base-string
-				    (string (caddr things)))))
-		  (t (apply #'concatenate 'string (mapcar #'string things))))))
-    (values (intern name)))))
+    (let* ((length (reduce #'+ things
+                           :key (lambda (x) (length (string x)))))
+           (name (make-array length :element-type 'character)))
+      (let ((index 0))
+        (dolist (thing things (values (intern name)))
+          (let* ((x (string thing))
+                 (len (length x)))
+            (replace name x :start1 index)
+            (incf index len)))))))
 
 ;;; like SYMBOLICATE, but producing keywords
 (defun keywordicate (&rest things)