From 362d6c36e225556d074ca55bc8abc7368aac1849 Mon Sep 17 00:00:00 2001 From: Common Lisp at Google Date: Fri, 23 Feb 2024 15:25:00 -0800 Subject: [PATCH] Remove with-creating-find-package PiperOrigin-RevId: 609852537 --- main.lisp | 43 ++++++++++++++++++++--------------------- sbcl.lisp | 36 ---------------------------------- test/features-test.lisp | 3 +-- 3 files changed, 22 insertions(+), 60 deletions(-) diff --git a/main.lisp b/main.lisp index 73c4b5c..df15691 100644 --- a/main.lisp +++ b/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*." diff --git a/sbcl.lisp b/sbcl.lisp index b7ee14e..7ca752b 100644 --- a/sbcl.lisp +++ b/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." diff --git a/test/features-test.lisp b/test/features-test.lisp index f61522a..5b82924 100644 --- a/test/features-test.lisp +++ b/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