0.6.11.17:

[sbcl.git] / src / code / defboot.lisp

diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp
index 4e9854c..89c3111 100644 (file)
--- a/src/code/defboot.lisp
+++ b/src/code/defboot.lisp
@@ -19,9 +19,6 @@
 ;;;; files for more information.
 
 (in-package "SB!IMPL")
-
-(file-comment
-  "$Header$")
 \f
 ;;;; IN-PACKAGE
 
@@ -29,7 +26,7 @@
   `(eval-when (:compile-toplevel :load-toplevel :execute)
      (setq *package* (find-undeleted-package-or-lose ',package-designator))))
 \f
-;;; MULTIPLE-VALUE-FOO
+;;;; MULTIPLE-VALUE-FOO
 
 (defun list-of-symbols-p (x)
   (and (listp x)
@@ -59,9 +56,7 @@
           `(multiple-value-bind (,g) ,value-form
              ,g)))
        ((list-of-symbols-p vars)
-        (let ((temps (mapcar #'(lambda (x)
-                                 (declare (ignore x))
-                                 (gensym)) vars)))
+        (let ((temps (make-gensym-list (length vars))))
           `(multiple-value-bind ,temps ,value-form
              ,@(mapcar #'(lambda (var temp)
                            `(setq ,var ,temp))
@@ -96,12 +91,12 @@
 ;;; other things defined in terms of COND
 (defmacro-mundanely when (test &body forms)
   #!+sb-doc
-  "First arg is a predicate. If it is non-null, the rest of the forms are
+  "If the first argument is true, the rest of the forms are
   evaluated as a PROGN."
   `(cond (,test nil ,@forms)))
 (defmacro-mundanely unless (test &body forms)
   #!+sb-doc
-  "First arg is a predicate. If it is null, the rest of the forms are
+  "If the first argument is not true, the rest of the forms are
   evaluated as a PROGN."
   `(cond ((not ,test) nil ,@forms)))
 (defmacro-mundanely and (&rest forms)
@@ -174,12 +169,7 @@
     (if (and (consp name) (eq (first name) 'setf))
        (setf (fdocumentation (second name) 'setf) doc)
        (setf (fdocumentation name 'function) doc)))
-  (sb!c::proclaim-as-function-name name)
-  (if (eq (info :function :where-from name) :assumed)
-      (progn
-       (setf (info :function :where-from name) :defined)
-       (if (info :function :assumed-type name)
-           (setf (info :function :assumed-type name) nil))))
+  (become-defined-function-name name)
   (when (or inline-expansion
            (info :function :inline-expansion name))
     (setf (info :function :inline-expansion name)
@@ -195,6 +185,16 @@
 (defun sb!c::%defun (name def doc source)
   (declare (ignore source))
   (setf (sb!eval:interpreted-function-name def) name)
+  (ecase (info :function :where-from name)
+    (:assumed
+      (setf (info :function :where-from name) :defined)
+      (setf (info :function :type name)
+              (extract-function-type def))
+      (when (info :function :assumed-type name)
+        (setf (info :function :assumed-type name) nil)))
+    (:declared)
+    (:defined
+        (setf (info :function :type name) (extract-function-type def))))
   (sb!c::%%defun name def doc))
 \f
 ;;;; DEFVAR and DEFPARAMETER