New generic function FIND-PACKAGE

code/reader/generic-functions.lisp

@@ -24,25 +24,6 @@
 
 ;;; Default methods for the reader state protocol
 
-(defmethod valid-state-value-p ((client t) (aspect (eql '*package*)) (value t))
-  (typep value '(or package alexandria:string-designator)))
-
-(defmethod state-value ((client t) (aspect (eql '*package*)))
-  *package*)
-
-(defmethod (setf state-value) ((new-value t)
-                               (client t)
-                               (aspect (eql '*package*)))
-  (setf *package* (find-package new-value))
-  new-value)
-
-(defmethod call-with-state-value ((client t)
-                                  (thunk t)
-                                  (aspect (eql '*package*))
-                                  (value t))
-  (let ((*package* (find-package value)))
-    (funcall thunk)))
-
 (macrolet ((define (aspect &key (variable aspect) predicate type)
              `(progn
                 (defmethod valid-state-value-p ((client t)
@@ -72,6 +53,7 @@
                     (funcall thunk))))))
   (define cl:*readtable*              :variable eclector.reader:*readtable*
                                       :predicate eclector.readtable:readtablep)
+  (define *package*                   :predicate packagep)
   (define *read-suppress*)
   (define *read-eval*)
   (define *features*                  :predicate listp)
@@ -130,6 +112,10 @@
   (:method ((client t) (designator string))
     (find-standard-character designator)))
 
+(defgeneric find-package (client designator)
+  (:method ((client t) designator)
+    (cl:find-package designator)))
+
 (defgeneric make-structure-instance (client name initargs))
 
 (defgeneric evaluate-expression (client expression)

code/reader/macro-functions.lisp

@@ -1323,6 +1323,20 @@
     ((cons (eql :and))
      (every recurse (rest feature-expression)))))
 
+(defun find-package-or-lose (client designator stream)
+  (loop for package = (find-package client designator)
+        when package
+          return package
+        do (restart-case
+               (%reader-error stream 'package-does-not-exist
+                              :package-name designator)
+             (use-value (new-designator)
+               :report (lambda (stream)
+                         (format-recovery-report stream 'use-replacement-package
+                                                 designator))
+               :interactive accept-package-name
+               (setf designator new-designator)))))
+
 (defun sharpsign-plus-minus (stream char parameter invertp)
   (declare (ignore char))
   (let ((client *client*)
@@ -1350,7 +1364,8 @@
                  (unread-char (%character condition) stream)
                  fallback-value))))
       (let ((feature-expression
-              (with-state-values (client '*package*       "KEYWORD"
+              (with-state-values (client '*package*
+                                         (find-package-or-lose client "KEYWORD" stream)
                                          '*read-suppress* nil)
                 (with-quasiquotation-state (client context t t)
                   (read-expression

code/reader/package.lisp

@@ -8,6 +8,7 @@
   ;; COMMON-LISP.
   (:shadow
    #:peek-char
+   #:find-package
    #:read
    #:read-preserving-whitespace
    #:read-from-string
@@ -98,6 +99,7 @@
 
    #:call-reader-macro
    #:find-character
+   #:find-package
    #:make-structure-instance
 
    #:evaluate-expression

code/reader/tokens.lisp

@@ -613,8 +613,8 @@
    package
      (setf package (case package-indicator
                      (:current (state-value client '*package*))
-                     (:keyword (find-package "KEYWORD"))
-                     (t        (or (find-package package-indicator)
+                     (:keyword (find-package client "KEYWORD"))
+                     (t        (or (find-package client package-indicator)
                                    (multiple-value-bind (value kind)
                                        (package-does-not-exist
                                         input-stream

code/reader/variables.lisp

@@ -9,7 +9,7 @@
 
 (cl:in-package #:eclector.reader)
 
-(defparameter *package* (find-package '#:common-lisp-user))
+(defparameter *package* (cl:find-package '#:common-lisp-user))
 
 (defparameter *read-eval* t)
 

code/syntax-extensions/extended-package-prefix.lisp

@@ -41,5 +41,5 @@
          client
          (lambda ()
            (eclector.reader:read input-stream t nil t))
-         '*package* package-name))
+         '*package* (eclector.reader:find-package client package-name)))
       (call-next-method)))

documentation/chap-external-protocols.texi

@@ -625,6 +625,21 @@ to any particular client but is specialized to @var{designator} being a
 @t{character} just returns @var{designator}.
 @end deffn
 
+@defgena {find-package,@readerpackage{}} client designator
+
+This generic function is called by the reader to find the package with
+the given name. If no package with the given name exists, this function
+should return @t{nil}, as @t{cl:find-package} does.
+
+Unlike the standard @t{cl:find-package}, this function only needs to
+accept string designators, and not package objects. Because
+the reader only ever calls it with string designators, it does not have
+any defined behavior when called with other arguments.
+
+A default method on this generic function that is not specialized to any
+particular client uses @t{cl:find-package}.
+@end deffn
+
 @defgena {make-structure-instance,@readerpackage{}} client name initargs
 
 This generic function is called by the default @t{#S} reader
@@ -835,14 +850,13 @@ aspect that is recognized by @var{client}.  At least the aspects listed
 in the @ref{table:minimal-reader-state-aspects,,minimal reader state
 aspects table} must be recognized by any client.
 
-With the exceptions of @link{aspect-readtable,@t{cl:*readtable*}} and
-@link{aspect-package,@t{cl:*package*}}, the default methods on this
-generic function recognize state aspects and implement type restrictions
-informed by the @commonlisp{} specification:
+With the exception of @link{aspect-readtable,@t{cl:*readtable*}},
+the default methods on this generic function recognize state aspects
+and implement type restrictions informed by the @commonlisp{} specification:
 @multitable @columnfractions .3 .7
 @headitem Aspect                             @tab Type
 @item     @t{cl:*readtable*}                 @tab @t{(satisfies @rtpackage{}:readtablep)}
-@item     @t{cl:*package*}                   @tab @t{(or cl:package cl:symbol cl:string cl:character)} (package designator)
+@item     @t{cl:*package*}                   @tab @t{cl:package}
 @item     @t{cl:*read-suppress*}             @tab @t{t} (generalized Boolean)
 @item     @t{cl:*read-eval*}                 @tab @t{t} (generalized Boolean)
 @item     @t{cl:*features*}                  @tab @t{list} (proper list)
@@ -860,13 +874,6 @@ Return the current value of the reader state aspect designated by
 @var{client}.  At least the aspects listed in the
 @ref{table:minimal-reader-state-aspects,,minimal reader state aspects
 table} must be recognized by any client.
-
-The @link{aspect-package,@t{cl:*package*}} aspect mandates further
-explanation: When the client uses only the default methods of the reader
-state protocol, the return value of this generic function for the
-@t{cl:*package*} aspect is of type @speclink{t,package} which is a
-strict subtype of the type of valid values for this aspect.  In other
-words, the defaults coerce package designators to package objects.
 @end deffn
 
 @defgena{(setf state-value),@readerpackage{}} new-value client aspect
@@ -884,14 +891,6 @@ table} must be recognized by any client.
 that
 @code{(@genref{valid-state-value-p,@readerpackage{}} @var{client} @var{aspect} @var{value})}
 must return @emph{true}.
-
-The @link{aspect-package,@t{cl:*package*}} aspect mandates further
-explanation: When the client uses only the default methods of the reader
-state protocol, the method on this generic function which handles the
-@t{cl:*package*} aspect coerces @var{new-value} from designators to
-package objects so that a subsequent
-@genref{state-value,@readerpackage{}} call returns the designated
-package object.
 @end deffn
 
 @defgena{call-with-state-value,@readerpackage{}} client thunk aspect value
@@ -918,13 +917,6 @@ During the call to @var{thunk} and absent any intervening calls to
 @code{(@genref{state-value,@readerpackage{}} @var{client} @var{aspect})}
 must evaluate to @var{value}.
 @end itemize
-
-When @sysname{} calls this generic function with @t{cl:*package*} as the
-value of @var{aspect}, the @var{value} is a always a string designator
-and never a package object.  The default method on this generic function
-coerces such string designators to package objects so that a subsequent
-@genref{state-value,@readerpackage{}} call returns the designated
-package object.
 @end deffn
 
 @cindex quasiquote

test/reader/client.lisp

@@ -286,7 +286,7 @@
   (declare (ignore char))
   (let ((new-base (eclector.reader:read stream t nil t)))
     (setf (eclector.reader:state-value eclector.base:*client* '*package*)
-          new-base)
+          (find-package new-base))
     (values)))
 
 (test setf-state-value/smoke