0.8.10.72:
authorChristophe Rhodes <csr21@cam.ac.uk>
Mon, 31 May 2004 21:47:06 +0000 (21:47 +0000)
committerChristophe Rhodes <csr21@cam.ac.uk>
Mon, 31 May 2004 21:47:06 +0000 (21:47 +0000)
One more piece of unsupported speculative functionality: merge
CSR's deboostrap idea for find-package to better support tools
which want to reason about source code.
... I believe this should be enough to allow SLIME & friends
to present a seamless editing environment for sbcl
source code.  Maybe.

package-data-list.lisp-expr
src/code/target-package.lisp
version.lisp-expr

index 9315fca..3c64ce4 100644 (file)
@@ -799,6 +799,11 @@ retained, possibly temporariliy, because it might be used internally."
             ;; ..and CONDITIONs..
             "BUG"
             "UNSUPPORTED-OPERATOR"
+
+            "BOOTSTRAP-PACKAGE-NAME" 
+            "BOOTSTRAP-PACKAGE-NOT-FOUND"
+            "DEBOOTSTRAP-PACKAGE"
+
             "REFERENCE-CONDITION" "REFERENCE-CONDITION-REFERENCES"
             "*PRINT-CONDITION-REFERENCES*"
 
index 5caa525..ab640e9 100644 (file)
 (!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)))
index e10b284..6571c7f 100644 (file)
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.10.71"
+"0.8.10.72"