0.7.8.36:

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

diff --git a/src/code/package.lisp b/src/code/package.lisp
index 4078b05..e376b9d 100644 (file)
--- a/src/code/package.lisp
+++ b/src/code/package.lisp
@@ -11,9 +11,6 @@
 ;;;; files for more information.
 
 (in-package "SB!IMPL")
-
-(file-comment
-  "$Header$")
 \f
 ;;;; the PACKAGE-HASHTABLE structure
 
@@ -38,10 +35,10 @@
 (sb!xc:defstruct (package-hashtable (:constructor %make-package-hashtable ())
                                    (:copier nil))
   ;; The g-vector of symbols.
-  ;; FIXME: could just be type SIMPLE-VECTOR, with REQUIRED-ARGUMENT
+  ;; FIXME: could just be type SIMPLE-VECTOR, with (MISSING-ARG) default
   (table nil :type (or simple-vector null))
   ;; The i-vector of pname hash values.
-  ;; FIXME: could just be type HASH-VECTOR, with REQUIRED-ARGUMENT
+  ;; FIXME: could just be type HASH-VECTOR, with (MISSING-ARG) default
   (hash nil :type (or hash-vector null))
   ;; The total number of entries allowed before resizing.
   ;;
@@ -59,8 +56,9 @@
 ;;; KLUDGE: We use DEF!STRUCT to define this not because we need to
 ;;; manipulate target package objects on the cross-compilation host,
 ;;; but only because its MAKE-LOAD-FORM function needs to be hooked
-;;; into the pre-CLOS DEF!STRUCT MAKE-LOAD-FORM system. The DEF!STRUCT
-;;; side-effect of defining a new PACKAGE type on the
+;;; into the pre-CLOS DEF!STRUCT MAKE-LOAD-FORM system so that we can
+;;; compile things like IN-PACKAGE in warm init before CLOS is set up.
+;;; The DEF!STRUCT side effect of defining a new PACKAGE type on the
 ;;; cross-compilation host is just a nuisance, and in order to avoid
 ;;; breaking the cross-compilation host, we need to work around it
 ;;; around by putting the new PACKAGE type (and the PACKAGEP predicate
@@ -96,8 +94,8 @@
   ;; packages that use this package
   (%used-by-list () :type list)
   ;; PACKAGE-HASHTABLEs of internal & external symbols
-  (internal-symbols (required-argument) :type package-hashtable)
-  (external-symbols (required-argument) :type package-hashtable)
+  (internal-symbols (missing-arg) :type package-hashtable)
+  (external-symbols (missing-arg) :type package-hashtable)
   ;; shadowing symbols
   (%shadowing-symbols () :type list)
   ;; documentation string for this package
@@ -113,7 +111,7 @@
   "DO-SYMBOLS (VAR [PACKAGE [RESULT-FORM]]) {DECLARATION}* {TAG | FORM}*
    Executes the FORMs at least once for each symbol accessible in the given
    PACKAGE with VAR bound to the current symbol."
-  (multiple-value-bind (body decls) body-decls
+  (multiple-value-bind (body decls) (parse-body body-decls nil)
     (let ((flet-name (gensym "DO-SYMBOLS-")))
       `(block nil
         (flet ((,flet-name (,var)
@@ -230,10 +228,10 @@
         (inherited-symbol-p (gensym))
         (BLOCK (gensym)))
     `(let* ((,these-packages ,package-list)
-           (,packages `,(mapcar #'(lambda (package)
-                                    (if (packagep package)
-                                        package
-                                        (find-package package)))
+           (,packages `,(mapcar (lambda (package)
+                                  (if (packagep package)
+                                      package
+                                      (find-package package)))
                                 (if (consp ,these-packages)
                                     ,these-packages
                                     (list ,these-packages))))
@@ -256,7 +254,8 @@
                                    (car ,',packages))))
                     (when ,symbols
                       (setf ,',vector (package-hashtable-table ,symbols))
-                      (setf ,',hash-vector (package-hashtable-hash ,symbols)))))
+                      (setf ,',hash-vector
+                            (package-hashtable-hash ,symbols)))))
                 (:external
                  `(let ((,symbols (package-external-symbols
                                    (car ,',packages))))
@@ -282,15 +281,15 @@
                                  (,',init-macro ,(car ',ordered-types)))))))
         (when ,packages
           ,(when (null symbol-types)
-             (error 'program-error
+             (error 'simple-program-error
                     :format-control
-                    "Must supply at least one of :internal, :external, or ~
-                     :inherited."))
+                    "At least one of :INTERNAL, :EXTERNAL, or ~
+                     :INHERITED must be supplied."))
           ,(dolist (symbol symbol-types)
              (unless (member symbol '(:internal :external :inherited))
                (error 'program-error
                       :format-control
-                      "~S is not one of :internal, :external, or :inherited."
+                      "~S is not one of :INTERNAL, :EXTERNAL, or :INHERITED."
                       :format-argument symbol)))
           (,init-macro ,(car ordered-types))
           (flet ((,real-symbol-p (number)
@@ -302,7 +301,8 @@
                     ,@(when (member :internal ',ordered-types)
                         `((:internal
                            (setf ,',counter
-                                 (position-if #',',real-symbol-p ,',hash-vector
+                                 (position-if #',',real-symbol-p
+                                              ,',hash-vector
                                               :start (if ,',counter
                                                          (1+ ,',counter)
                                                          0)))
@@ -314,7 +314,8 @@
                     ,@(when (member :external ',ordered-types)
                         `((:external
                            (setf ,',counter
-                                 (position-if #',',real-symbol-p ,',hash-vector
+                                 (position-if #',',real-symbol-p
+                                              ,',hash-vector
                                               :start (if ,',counter
                                                          (1+ ,',counter)
                                                          0)))