0.8.10.72:

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

diff --git a/src/code/target-package.lisp b/src/code/target-package.lisp
index 23e9150..ab640e9 100644 (file)
--- a/src/code/target-package.lisp
+++ b/src/code/target-package.lisp
@@ -130,12 +130,29 @@
 (!cold-init-forms
   (setf *!deferred-use-packages* nil))
 
-;;; FIXME: I rewrote this. Test it and the stuff that calls it.
+(define-condition bootstrap-package-not-found (condition)
+  ((name :initarg :name :reader bootstrap-package-name)))
+(defun debootstrap-package (&optional condition)
+  (invoke-restart 
+   (find-restart-or-control-error 'debootstrap-package condition)))
+  
 (defun find-package (package-designator)
   (flet ((find-package-from-string (string)
           (declare (type string string))
-          (values (gethash string *package-names*))))
-    (declare (inline find-package-from-string))
+          (let ((packageoid (gethash string *package-names*)))
+            (when (and (null packageoid)
+                       (not *in-package-init*) ; KLUDGE
+                       (let ((mismatch (mismatch "SB!" string)))
+                         (and mismatch (= mismatch 3))))
+              (restart-case
+                  (signal 'bootstrap-package-not-found :name string)
+                (debootstrap-package ()
+                  (return-from find-package
+                    (if (string= string "SB!XC")
+                        (find-package "COMMON-LISP")
+                        (find-package 
+                         (substitute #\- #\! string :count 1)))))))
+            packageoid)))
     (typecase package-designator
       (package package-designator)
       (symbol (find-package-from-string (symbol-name package-designator)))
@@ -540,9 +557,9 @@
           (let ((sym (read *query-io*)))
             (cond
              ((not (symbolp sym))
-              (format *query-io* "~S is not a symbol."))
+              (format *query-io* "~S is not a symbol." sym))
              ((not (member sym cset))
-              (format *query-io* "~S is not one of the conflicting symbols."))
+              (format *query-io* "~S is not one of the conflicting symbols." sym))
              (t
               (shadowing-import sym package)
               (return-from unintern t)))))))
@@ -818,7 +835,8 @@
          (when cset
            (cerror
             "Unintern the conflicting symbols in the ~2*~A package."
-            "Use'ing package ~A results in name conflicts for these symbols:~%~S"
+            "Using package ~A results in name conflicts for these symbols:~%~
+              ~S"
             (package-%name pkg) cset (package-%name package))
            (dolist (s cset) (moby-unintern s package))))
 
@@ -877,7 +895,8 @@
        (do-symbols (symbol package)
          (when (and (eq (symbol-package symbol) package)
                     (or (not external-only)
-                        (eq (find-symbol (symbol-name symbol) package)
+                        (eq (nth-value 1 (find-symbol (symbol-name symbol)
+                                                      package))
                             :external))
                     (search string (symbol-name symbol) :test #'char-equal))
            (push symbol result)))
@@ -938,7 +957,9 @@
        (add-symbol external symbol))
 
       ;; Put shadowing symbols in the shadowing symbols list.
-      (setf (package-%shadowing-symbols pkg) (sixth spec))))
+      (setf (package-%shadowing-symbols pkg) (sixth spec))
+      ;; Set the package documentation
+      (setf (package-doc-string pkg) (seventh spec))))
 
   ;; FIXME: These assignments are also done at toplevel in
   ;; boot-extensions.lisp. They should probably only be done once.