Remove with-creating-find-package

main.lisp

@@ -589,30 +589,29 @@ If LISP_MAIN is NIL or T it will call top-level REPL as well."
   "Return a symbol feature derived from a FEATURE string or symbol.
 
 By default the string is read into the KEYWORD package.
-If the feature string is package prefixed, the package
-is instantiated unless already provided.
-
-If the feature parses as anything other than a symbol,
-it will signal an error."
-  (typecase feature
+If the feature string is package prefixed, the package is made
+with a default :USE list of (\"CL\") unless it already exists."
+  (etypecase feature
     (symbol feature)
     (string
-     (multiple-value-bind (value error)
-         (ignore-errors
-          (let ((*package* (find-package "KEYWORD")))
-            (with-creating-find-package ()
-              (values (read-from-string feature)))))
-       (cond ((and (symbolp value) value))
-             (error
-              (bazel.log:fatal
-               "Could not parse ~S as a feature due to~% ~S: ~A~%"
-               feature (type-of error) error)
-              nil)
-             (t
-              (bazel.log:fatal "Cannot parse ~S as a feature." feature)
-              nil))))
-    (t
-     (bazel.log:fatal "~S is not a feature." feature))))
+     ;; Like the ~/ format directive, it makes no difference whether the feature
+     ;; is spelled using 1 colon or 2; and while #\\ and #\| escapes are not
+     ;; prohibited, they have ordinary character syntax.
+     (let* ((string (string-upcase (string-trim '(#\sp) feature)))
+            (colon (position #\: string))
+            (pkgname (subseq string 0 colon))
+            (colon2 (and colon
+                         (eql (if (< colon (1- (length string))) (char string (1+ colon)))
+                              #\:)
+                         (1+ colon)))
+            (sym (subseq string (1+ (or colon2 colon -1)))))
+       (if (or (position #\: sym) (= (length sym) 0))
+           (bazel.log:fatal "~S is not a feature designator~%" feature)
+           (values (intern sym
+                           (cond ((or (not colon) (string= pkgname ""))
+                                  (find-package "KEYWORD"))
+                                 ((find-package pkgname))
+                                 (t (make-package pkgname :use '("CL")))))))))))
 
 (defun add-feature (feature)
   "Add a single string FEATURE to *features*."

sbcl.lisp

@@ -38,7 +38,6 @@
            #:setup-readtable
            #:remove-extra-debug-info
            #:name-closure
-           #:with-creating-find-package
            #:with-default-package
            ;; threading
            #:make-thread
@@ -325,41 +324,6 @@
   (setf (sb-ext:readtable-base-char-preference rt) :both)
   rt)
 
-(defvar *in-find-package* nil "Prevents cycles in make-package")
-(defvar *with-creating-find-package-mutex* (make-mutex :name "with-creating-find-package-mutex"))
-
-(defun call-with-augmented-find-package (body &key (use '("COMMON-LISP")) (default nil))
-  "Calls the BODY after making sure that the reader
- will not error on unknown packages or not exported symbols.
- USE is the set of packages to use by the new package.
- This affects _all_ threads' calls to FIND-PACKAGE, and
- is generally not appropriate to use in production code"
-  (declare (function body))
-  ;; The instant that ENCAPSULATE stores the new definition of FIND-PACKAGE, we must
-  ;; accept that any thread - whether already running, or newly created - can access
-  ;; our local function as a consequence of needing FIND-PACKAGE for any random reason.
-  ;; Were the closure allocated on this thread's stack, then this function's frame
-  ;; would be forbidden from returning until no other thread was executing the code
-  ;; that was made globally visible. Since there's no way to determine when the last
-  ;; execution has ended, the FLET body has indefinite, not dynamic, extent.
-  (flet ((creating-find-package (f name)
-           (or (funcall f name)
-               default
-               (unless *in-find-package*
-                 (let ((*in-find-package* t))
-                   (make-package name :use use))))))
-    (with-recursive-lock (*with-creating-find-package-mutex*)
-      (sb-int:encapsulate 'find-package 'create #'creating-find-package)
-      (unwind-protect
-           (handler-bind ((package-error #'continue))
-             (funcall body))
-        (sb-int:unencapsulate 'find-package 'create)))))
-
-(defmacro with-creating-find-package ((&key (use '("COMMON-LISP"))) &body body)
-  "Executes body in an environment where FIND-PACKAGE will not signal an unknown package error.
- Instead it will create the package with the missing name with the provided USE packages."
-  `(call-with-augmented-find-package (lambda () ,@body) :use ',use))
-
 (defmacro with-default-package ((default) &body body)
   "Executes body in an environment where FIND-PACKAGE will not signal an unknown package error.
  Instead it will return the DEFAULT package."

test/features-test.lisp

@@ -13,8 +13,7 @@
   (assert (eq 'cl-user::xyz1234567890
               (bazel.main::to-feature "cl-user:xyz1234567890")))
 
-  (assert (null (ignore-errors (bazel.main::to-feature "123"))))
-  (assert (null (ignore-errors (bazel.main::to-feature "()"))))
+  (assert (eq :|123| (bazel.main::to-feature "123")))
   (assert (null (ignore-errors (bazel.main::to-feature 123))))
 
   (assert (find :bazel *features*)) ; NOLINT