X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fprimordial-extensions.lisp;h=4a86b53537e291dfa5c5b5ab73f54c080cb502c3;hb=b3a419f10ad442a1c59d51edabdc70518f193648;hp=92995217e27cc9aa1557428c632baefcbf1978d7;hpb=8ac4c19014a23665e5842d0a989cb9d22d1592ed;p=sbcl.git

diff --git a/src/code/primordial-extensions.lisp b/src/code/primordial-extensions.lisp
index 9299521..4a86b53 100644
--- a/src/code/primordial-extensions.lisp
+++ b/src/code/primordial-extensions.lisp
@@ -149,9 +149,23 @@
 ;;; producing a symbol in the current package.
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun symbolicate (&rest things)
-    (values (intern (apply #'concatenate
-			   'string
-			   (mapcar #'string 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-string (string (car things)))))
+		  (2 (concatenate 'string 
+				  (the simple-string (string (car things)))
+				  (the simple-string (string (cadr things)))))
+		  (3 (concatenate 'string
+				  (the simple-string (string (car things)))
+				  (the simple-string (string (cadr things)))
+				  (the simple-string (string (caddr things)))))
+		  (t (apply #'concatenate 'string (mapcar #'string things))))))
+    (values (intern name)))))
 
 ;;; like SYMBOLICATE, but producing keywords
 (defun keywordicate (&rest things)
@@ -258,6 +272,7 @@
      (%defconstant-eqx-value ',symbol ,expr ,eqx)
      ,@(when doc (list doc))))
 (defun %defconstant-eqx-value (symbol expr eqx)
+  (declare (type function eqx))
   (flet ((bummer (explanation)
 	   (error "~@<bad DEFCONSTANT-EQX ~S ~2I~_~S: ~2I~_~A ~S~:>"
 		  symbol