X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdefboot.lisp;h=0f3af74fe739e50578d602610f22c764d7702882;hb=b5703d98da9ebfd688c87e14862ab4e26dc94d14;hp=f0959353d007ff78bcb91471017623f2aaeb91c3;hpb=cea4896b2482b7b2b429c1631d774b4cfbc0efba;p=sbcl.git

diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp
index f095935..0f3af74 100644
--- a/src/code/defboot.lisp
+++ b/src/code/defboot.lisp
@@ -26,7 +26,7 @@
   `(eval-when (:compile-toplevel :load-toplevel :execute)
      (setq *package* (find-undeleted-package-or-lose ',package-designator))))
 
-;;; MULTIPLE-VALUE-FOO
+;;;; MULTIPLE-VALUE-FOO
 
 (defun list-of-symbols-p (x)
   (and (listp x)
@@ -91,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)
@@ -161,43 +161,65 @@
 					; undefined function warnings
 #+sb-xc-host (/show "after PROCLAIM" (sb!c::info :function :kind 'sb!c::%%defun))
 (defun sb!c::%%defun (name def doc &optional inline-expansion)
-  (when (fboundp name)
-    (style-warn "redefining ~S in DEFUN" name))
-  (setf (sb!xc:fdefinition name) def)
-  (when doc
-    ;; FIXME: This should use shared SETF-name parsing logic.
-    (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))))
+  ;; When we're built as a cross-compiler, the DEF is a function
+  ;; implemented by the cross-compilation host, which is opaque to us.
+  ;; Similarly, other things like FDEFINITION or DOCUMENTATION either
+  ;; aren't ours to mess with or are meaningless to mess with. Thus,
+  ;; we punt.
+  #+sb-xc-host (declare (ignore def))
+  #-sb-xc-host 
+  (progn
+    (when (fboundp name)
+      (style-warn "redefining ~S in DEFUN" name))
+    (setf (sb!xc:fdefinition name) def)
+    (when doc
+      ;; FIXME: This should use shared SETF-name-parsing logic.
+      (if (and (consp name) (eq (first name) 'setf))
+	  (setf (fdocumentation (second name) 'setf) doc)
+	  (setf (fdocumentation name 'function) doc))))
+  ;; Other stuff remains meaningful whether we're cross-compiling or
+  ;; native compiling.
+  (become-defined-function-name name)
   (when (or inline-expansion
 	    (info :function :inline-expansion name))
     (setf (info :function :inline-expansion name)
 	  inline-expansion))
+  ;; Voila.
   name)
-;;; Ordinarily this definition of SB!C:%DEFUN as an ordinary function is not
-;;; used: the parallel (but different) definition as an IR1 transform takes
-;;; precedence. However, it's still good to define this in order to keep the
-;;; interpreter happy. We define it here (instead of alongside the parallel
-;;; IR1 transform) because while the IR1 transform is needed and appropriate
-;;; in the cross-compiler running in the host Common Lisp, this parallel
-;;; ordinary function definition is only appropriate in the target Lisp.
+;;; FIXME: Now that the IR1 interpreter is going away and EVAL-WHEN is
+;;; becoming ANSI-compliant, it should be possible to merge this and
+;;; DEF-IR1-TRANSLATOR %DEFUN into a single DEFUN. (And does %%DEFUN
+;;; merge into that too? dunno..)
 (defun sb!c::%defun (name def doc source)
   (declare (ignore source))
-  (setf (sb!eval:interpreted-function-name def) name)
+  (flet ((set-type-info-from-def ()
+           (setf (info :function :type name)
+		 #-sb-xc-host (extract-function-type def)
+		 ;; When we're built as a cross-compiler, the DEF is
+		 ;; a function implemented by the cross-compilation
+		 ;; host, which is opaque to us, so we have to punt here.
+		 #+sb-xc-host *universal-function-type*)))
+    (ecase (info :function :where-from name)
+      (:assumed
+       (setf (info :function :where-from name) :defined)
+       (set-type-info-from-def)
+       (when (info :function :assumed-type name)
+	 (setf (info :function :assumed-type name) nil)))
+      (:declared)
+      (:defined
+       (set-type-info-from-def)
+       ;; We shouldn't need to clear this here because it should be
+       ;; clear already (having been cleared when the last definition
+       ;; was processed).
+       (aver (null (info :function :assumed-type name))))))
   (sb!c::%%defun name def doc))
 
 ;;;; DEFVAR and DEFPARAMETER
 
 (defmacro-mundanely defvar (var &optional (val nil valp) (doc nil docp))
   #!+sb-doc
-  "For defining global variables at top level. Declares the variable
-  SPECIAL and, optionally, initializes it. If the variable already has a
+  "Define a global variable at top level. Declare the variable
+  SPECIAL and, optionally, initialize it. If the variable already has a
   value, the old value is not clobbered. The third argument is an optional
   documentation string for the variable."
   `(progn
@@ -211,10 +233,11 @@
 
 (defmacro-mundanely defparameter (var val &optional (doc nil docp))
   #!+sb-doc
-  "Defines a parameter that is not normally changed by the program,
-  but that may be changed without causing an error. Declares the
-  variable special and sets its value to VAL. The third argument is
-  an optional documentation string for the parameter."
+  "Define a parameter that is not normally changed by the program,
+  but that may be changed without causing an error. Declare the
+  variable special and sets its value to VAL, overwriting any
+  previous value. The third argument is an optional documentation
+  string for the parameter."
   `(progn
      (declaim (special ,var))
      (setq ,var ,val)
@@ -227,11 +250,11 @@
 
 ;;;; iteration constructs
 
-;;; (These macros are defined in terms of a function DO-DO-BODY which is also
-;;; used by SB!INT:DO-ANONYMOUS. Since these macros should not be loaded
-;;; on the cross-compilation host, but SB!INT:DO-ANONYMOUS and DO-DO-BODY
-;;; should be, these macros can't conveniently be in the same file as
-;;; DO-DO-BODY.)
+;;; (These macros are defined in terms of a function DO-DO-BODY which
+;;; is also used by SB!INT:DO-ANONYMOUS. Since these macros should not
+;;; be loaded on the cross-compilation host, but SB!INT:DO-ANONYMOUS
+;;; and DO-DO-BODY should be, these macros can't conveniently be in
+;;; the same file as DO-DO-BODY.)
 (defmacro-mundanely do (varlist endlist &body body)
   #!+sb-doc
   "DO ({(Var [Init] [Step])}*) (Test Exit-Form*) Declaration* Form*
@@ -255,12 +278,13 @@
   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)
@@ -283,13 +307,14 @@
       (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)