From 1abf1bd036dfec0b097310babd2c544486bba42f Mon Sep 17 00:00:00 2001 From: Bike Date: Fri, 5 Dec 2025 15:51:40 -0500 Subject: [PATCH] New generic function FIND-PACKAGE This simplifies the definition of the state-value protocol and makes it possible for clients to use an alternate package system without having to redefine INTERPRET-SYMBOL and the #+ #- macros. I'm not sure how to provide a generic recovery for not finding a keyword package. The extended package prefix code is also probably a problem as it ought to signal an error. --- code/reader/generic-functions.lisp | 24 ++-------- code/reader/macro-functions.lisp | 17 ++++++- code/reader/package.lisp | 2 + code/reader/tokens.lisp | 4 +- code/reader/variables.lisp | 2 +- .../extended-package-prefix.lisp | 2 +- documentation/chap-external-protocols.texi | 46 ++++++++----------- test/reader/client.lisp | 2 +- 8 files changed, 47 insertions(+), 52 deletions(-) diff --git a/code/reader/generic-functions.lisp b/code/reader/generic-functions.lisp index dc9b454b..b2316fb3 100644 --- a/code/reader/generic-functions.lisp +++ b/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) diff --git a/code/reader/macro-functions.lisp b/code/reader/macro-functions.lisp index d77ba9c7..0cbfed66 100644 --- a/code/reader/macro-functions.lisp +++ b/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 diff --git a/code/reader/package.lisp b/code/reader/package.lisp index 5e6abe5e..a73d5f7d 100644 --- a/code/reader/package.lisp +++ b/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 diff --git a/code/reader/tokens.lisp b/code/reader/tokens.lisp index a776f2a1..2fc51fa0 100644 --- a/code/reader/tokens.lisp +++ b/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 diff --git a/code/reader/variables.lisp b/code/reader/variables.lisp index eb610580..6d17d31a 100644 --- a/code/reader/variables.lisp +++ b/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) diff --git a/code/syntax-extensions/extended-package-prefix.lisp b/code/syntax-extensions/extended-package-prefix.lisp index 0c9e2163..87c45429 100644 --- a/code/syntax-extensions/extended-package-prefix.lisp +++ b/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))) diff --git a/documentation/chap-external-protocols.texi b/documentation/chap-external-protocols.texi index f036f6eb..39d52ff3 100644 --- a/documentation/chap-external-protocols.texi +++ b/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 diff --git a/test/reader/client.lisp b/test/reader/client.lisp index 2d96d473..5492f3c3 100644 --- a/test/reader/client.lisp +++ b/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