0.pre7.11:

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

diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp
index e280779..ccc2c4b 100644 (file)
--- a/src/code/defboot.lisp
+++ b/src/code/defboot.lisp
@@ -19,9 +19,6 @@
 ;;;; files for more information.
 
 (in-package "SB!IMPL")
 ;;;; files for more information.
 
 (in-package "SB!IMPL")

-
-(file-comment
-  "$Header$")

 \f
 ;;;; IN-PACKAGE
 
 \f
 ;;;; IN-PACKAGE
 

@@ -29,7 +26,7 @@
   `(eval-when (:compile-toplevel :load-toplevel :execute)
      (setq *package* (find-undeleted-package-or-lose ',package-designator))))
 \f
   `(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)
 
 (defun list-of-symbols-p (x)
   (and (listp x)

@@ -94,12 +91,12 @@
 ;;; other things defined in terms of COND
 (defmacro-mundanely when (test &body forms)
   #!+sb-doc
 ;;; 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
   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)
   evaluated as a PROGN."
   `(cond ((not ,test) nil ,@forms)))
 (defmacro-mundanely and (&rest forms)

@@ -172,12 +169,7 @@
     (if (and (consp name) (eq (first name) 'setf))
        (setf (fdocumentation (second name) 'setf) doc)
        (setf (fdocumentation name 'function) doc)))
     (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)
   (when (or inline-expansion
            (info :function :inline-expansion name))
     (setf (info :function :inline-expansion name)

@@ -193,6 +185,20 @@
 (defun sb!c::%defun (name def doc source)
   (declare (ignore source))
   (setf (sb!eval:interpreted-function-name def) name)
 (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))
+     ;; We shouldn't need to clear this here because it should be clear
+     ;; already (cleared when the last definition was processed).
+     (aver (null (info :function :assumed-type name)))))

   (sb!c::%%defun name def doc))
 \f
 ;;;; DEFVAR and DEFPARAMETER
   (sb!c::%%defun name def doc))
 \f
 ;;;; DEFVAR and DEFPARAMETER

@@ -258,12 +264,13 @@
   allowing RETURN to be used as an laternate exit mechanism."
   (do-do-body varlist endlist body 'let* 'setq 'do* nil))
 
   allowing RETURN to be used as an laternate exit mechanism."
   (do-do-body varlist endlist body 'let* 'setq 'do* nil))
 

-;;; DOTIMES and DOLIST could be defined more concisely using destructuring
-;;; macro lambda lists or DESTRUCTURING-BIND, but then it'd be tricky to use
-;;; them before those things were defined. They're used enough times before
-;;; destructuring mechanisms are defined that it looks as though it's worth
-;;; just implementing them ASAP, at the cost of being unable to use the
-;;; standard destructuring mechanisms.
+;;; DOTIMES and DOLIST could be defined more concisely using
+;;; destructuring macro lambda lists or DESTRUCTURING-BIND, but then
+;;; it'd be tricky to use them before those things were defined.
+;;; They're used enough times before destructuring mechanisms are
+;;; defined that it looks as though it's worth just implementing them
+;;; ASAP, at the cost of being unable to use the standard
+;;; destructuring mechanisms.

 (defmacro-mundanely dotimes (var-count-result &body body)
   (multiple-value-bind ; to roll our own destructuring
       (var count result)
 (defmacro-mundanely dotimes (var-count-result &body body)
   (multiple-value-bind ; to roll our own destructuring
       (var count result)

@@ -286,13 +293,14 @@
       (apply (lambda (var list &optional (result nil))
               (values var list result))
             var-list-result)
       (apply (lambda (var list &optional (result nil))
               (values var list result))
             var-list-result)

-    ;; We repeatedly bind the var instead of setting it so that we never have
-    ;; to give the var an arbitrary value such as NIL (which might conflict
-    ;; with a declaration). If there is a result form, we introduce a
-    ;; gratuitous binding of the variable to NIL w/o the declarations, then
-    ;; evaluate the result form in that environment. We spuriously reference
-    ;; the gratuitous variable, since we don't want to use IGNORABLE on what
-    ;; might be a special var.
+    ;; We repeatedly bind the var instead of setting it so that we
+    ;; never have to give the var an arbitrary value such as NIL
+    ;; (which might conflict with a declaration). If there is a result
+    ;; form, we introduce a gratuitous binding of the variable to NIL
+    ;; without the declarations, then evaluate the result form in that
+    ;; environment. We spuriously reference the gratuitous variable,
+    ;; since we don't want to use IGNORABLE on what might be a special
+    ;; var.

     (let ((n-list (gensym)))
       `(do ((,n-list ,list (cdr ,n-list)))
           ((endp ,n-list)
     (let ((n-list (gensym)))
       `(do ((,n-list ,list (cdr ,n-list)))
           ((endp ,n-list)