;;;; files for more information.
(in-package "SB!KERNEL")
-\f
-;;;; restarts
-;;; a list of lists of restarts
-(defvar *restart-clusters* '())
+(defun muffle-warning-p (warning)
+ (declare (special *muffled-warnings*))
+ (typep warning *muffled-warnings*))
+
+(defun initial-handler-clusters ()
+ `(((warning . ,#'(lambda (warning)
+ (when (muffle-warning-p warning)
+ (muffle-warning warning)))))))
-;;; an ALIST (condition . restarts) which records the restarts currently
-;;; associated with Condition
-(defvar *condition-restarts* ())
+;;; an alist with elements of the form
+;;;
+;;; (CONDITION . (HANDLER1 HANDLER2 ...))
+;;;
+;;; Recently established handlers are added at the beginning of the
+;;; list. Elements to the left of the alist take precedence over
+;;; elements to the right.
+(defvar *handler-clusters* (initial-handler-clusters))
+
+;;; a list of lists of currently active RESTART instances. maintained
+;;; by RESTART-BIND.
+(defvar *restart-clusters* '())
-(defstruct (restart (:copier nil) (:predicate nil))
+(declaim (inline restart-test-function
+ restart-associated-conditions
+ (setf restart-associated-conditions)))
+(defstruct (restart (:constructor make-restart
+ ;; Having TEST-FUNCTION at the end allows
+ ;; to not replicate its default value in RESTART-BIND.
+ (name function
+ &optional report-function
+ interactive-function
+ test-function))
+ (:copier nil) (:predicate nil))
(name (missing-arg) :type symbol :read-only t)
- (function (missing-arg) :type function)
- (report-function nil :type (or null function))
- (interactive-function nil :type (or null function))
- (test-function (lambda (cond) (declare (ignore cond)) t) :type function))
+ (function (missing-arg) :type function :read-only t)
+ (report-function nil :type (or null function) :read-only t)
+ (interactive-function nil :type (or null function) :read-only t)
+ (test-function (lambda (cond) (declare (ignore cond)) t) :type function :read-only t)
+ ;; the list of conditions which are currently associated to the
+ ;; restart. maintained by WITH-CONDITION-RESTARTS in a neither
+ ;; thread- nor interrupt-safe way. This should not be a problem
+ ;; however, since safe uses of restarts have to assume dynamic
+ ;; extent.
+ (associated-conditions '() :type list))
+
+#!-sb-fluid (declaim (freeze-type restart))
+
(def!method print-object ((restart restart) stream)
(if *print-escape*
(print-unreadable-object (restart stream :type t :identity t)
- (prin1 (restart-name restart) stream))
+ (prin1 (restart-name restart) stream))
(restart-report restart stream)))
-(defun compute-restarts (&optional condition)
- #!+sb-doc
- "Return a list of all the currently active restarts ordered from most
- recently established to less recently established. If CONDITION is
- specified, then only restarts associated with CONDITION (or with no
- condition) will be returned."
- (let ((associated ())
- (other ()))
- (dolist (alist *condition-restarts*)
- (if (eq (car alist) condition)
- (setq associated (cdr alist))
- (setq other (append (cdr alist) other))))
- (collect ((res))
- (dolist (restart-cluster *restart-clusters*)
- (dolist (restart restart-cluster)
- (when (and (or (not condition)
- (member restart associated)
- (not (member restart other)))
- (funcall (restart-test-function restart)
- condition))
- (res restart))))
- (res))))
-
#!+sb-doc
(setf (fdocumentation 'restart-name 'function)
"Return the name of the given restart object.")
(defun restart-report (restart stream)
(funcall (or (restart-report-function restart)
- (let ((name (restart-name restart)))
- (lambda (stream)
- (if name (format stream "~S" name)
- (format stream "~S" restart)))))
- stream))
+ (lambda (stream)
+ (format stream "~S" (or (restart-name restart)
+ restart))))
+ stream))
-(defmacro with-condition-restarts (condition-form restarts-form &body body)
- #!+sb-doc
- "WITH-CONDITION-RESTARTS Condition-Form Restarts-Form Form*
- Evaluates the Forms in a dynamic environment where the restarts in the list
- Restarts-Form are associated with the condition returned by Condition-Form.
- This allows FIND-RESTART, etc., to recognize restarts that are not related
- to the error currently being debugged. See also RESTART-CASE."
- (let ((n-cond (gensym)))
- `(let ((*condition-restarts*
- (cons (let ((,n-cond ,condition-form))
- (cons ,n-cond
- (append ,restarts-form
- (cdr (assoc ,n-cond *condition-restarts*)))))
- *condition-restarts*)))
- ,@body)))
+(defvar *restart-test-stack* nil)
+
+;; Call FUNCTION with all restarts in the current dynamic environment,
+;; 1) that are associated to CONDITION (when CONDITION is NIL, all
+;; restarts are processed)
+;; 2) and for which the restart test returns non-NIL for CONDITION.
+;; When CALL-TEST-P is non-NIL, all restarts are processed.
+(defun map-restarts (function &optional condition (call-test-p t))
+ ;; FIXME: if MAP-RESTARTS is internal, we could require the FUNCTION
+ ;; argument to be of type FUNCTION.
+ (let ((function (coerce function 'function))
+ (stack *restart-test-stack*))
+ (dolist (restart-cluster *restart-clusters*)
+ (dolist (restart restart-cluster)
+ (when (and (or (not condition)
+ (null (restart-associated-conditions restart))
+ (memq condition (restart-associated-conditions restart)))
+ ;; A call to COMPUTE-RESTARTS -- from an error,
+ ;; from user code, whatever -- inside the test
+ ;; function would cause infinite recursion here, so
+ ;; we disable each restart using
+ ;; *restart-test-stack* for the duration of the
+ ;; test call.
+ (not (memq restart stack))
+ (or (not call-test-p)
+ (let ((*restart-test-stack* (cons restart stack)))
+ (declare (truly-dynamic-extent *restart-test-stack*))
+ (funcall (restart-test-function restart) condition))))
+ (funcall function restart))))))
-(defmacro restart-bind (bindings &body forms)
+(defun compute-restarts (&optional condition)
#!+sb-doc
- "Executes forms in a dynamic context where the given restart bindings are
- in effect. Users probably want to use RESTART-CASE. When clauses contain
- the same restart name, FIND-RESTART will find the first such clause."
- `(let ((*restart-clusters*
- (cons (list
- ,@(mapcar (lambda (binding)
- (unless (or (car binding)
- (member :report-function
- binding
- :test #'eq))
- (warn "Unnamed restart does not have a ~
- report function: ~S"
- binding))
- `(make-restart :name ',(car binding)
- :function ,(cadr binding)
- ,@(cddr binding)))
- bindings))
- *restart-clusters*)))
- ,@forms))
+ "Return a list of all the currently active restarts ordered from most recently
+established to less recently established. If CONDITION is specified, then only
+restarts associated with CONDITION (or with no condition) will be returned."
+ (collect ((result))
+ (map-restarts (lambda (restart) (result restart)) condition)
+ (result)))
+
+(defun %find-restart (identifier &optional condition (call-test-p t))
+ (flet ((eq-restart-p (restart)
+ (when (eq identifier restart)
+ (return-from %find-restart restart)))
+ (named-restart-p (restart)
+ (when (eq identifier (restart-name restart))
+ (return-from %find-restart restart))))
+ ;; TODO Question for reviewer: does the compiler infer this dx
+ ;; automatically?
+ (declare (truly-dynamic-extent #'eq-restart-p #'named-restart-p))
+ (if (typep identifier 'restart)
+ ;; TODO Questions for reviewer:
+ ;;
+ ;; The code under #+previous-... below breaks the abstraction
+ ;; introduced by MAP-RESTARTS, but is about twice as
+ ;; fast as #+equivalent-... . Also, it is a common case due to
+ ;;
+ ;; (INVOKE-RESTART RESTART)
+ ;; -> (FIND-RESTART-OR-CONTROL-ERROR RESTART)
+ ;; -> (FIND-RESTART RESTART)
+ ;;
+ ;; However, both #+previous-... and #+equivalent-... may be
+ ;; wrong altogether because of
+ ;; https://bugs.launchpad.net/sbcl/+bug/774410:
+ ;; The behavior expected in that report can be achieved by the
+ ;; following line (which is, of course, the slowest of all
+ ;; possibilities):
+ (map-restarts #'eq-restart-p condition call-test-p)
-(defun find-restart (name &optional condition)
+ #+equivalent-to-previous-sbcl-behavior--faster-but-see-bug-774410
+ (map-restarts #'eq-restart-p nil nil)
+
+ #+previous-behavior--fastest-but-see-bug-774410
+ (and (find-if (lambda (cluster) (find identifier cluster)) *restart-clusters*)
+ identifier)
+
+ (map-restarts #'named-restart-p condition call-test-p))))
+
+(defun find-restart (identifier &optional condition)
#!+sb-doc
- "Return the first restart named NAME. If NAME names a restart, the restart
- is returned if it is currently active. If no such restart is found, NIL is
- returned. It is an error to supply NIL as a name. If CONDITION is specified
- and not NIL, then only restarts associated with that condition (or with no
- condition) will be returned."
- (let ((restarts (compute-restarts condition)))
- (declare (type list restarts))
- (find-if (lambda (x)
- (or (eq x name)
- (eq (restart-name x) name)))
- restarts)))
+ "Return the first restart identified by IDENTIFIER. If IDENTIFIER is a symbol,
+then the innermost applicable restart with that name is returned. If IDENTIFIER
+is a restart, it is returned if it is currently active. Otherwise NIL is
+returned. If CONDITION is specified and not NIL, then only restarts associated
+with that condition (or with no condition) will be returned."
+ ;; Calls MAP-RESTARTS such that restart test functions are
+ ;; respected.
+ (%find-restart identifier condition))
+
+;;; helper for the various functions which are ANSI-spec'ed to do
+;;; something with a restart or signal CONTROL-ERROR if there is none
+(defun find-restart-or-control-error (identifier &optional condition (call-test-p t))
+ (or (%find-restart identifier condition call-test-p)
+ (error 'simple-control-error
+ :format-control "No restart ~S is active~@[ for ~S~]."
+ :format-arguments (list identifier condition))))
(defun invoke-restart (restart &rest values)
#!+sb-doc
"Calls the function associated with the given restart, passing any given
arguments. If the argument restart is not a restart or a currently active
- non-nil restart name, then a control-error is signalled."
+ non-nil restart name, then a CONTROL-ERROR is signalled."
(/show "entering INVOKE-RESTART" restart)
- (let ((real-restart (find-restart restart)))
- (unless real-restart
- (error 'simple-control-error
- :format-control "Restart ~S is not active."
- :format-arguments (list restart)))
- (/show (restart-name real-restart))
+ ;; The following code calls MAP-RESTARTS (through
+ ;; FIND-RESTART-OR-CONTROL-ERROR -> %FIND-RESTART) such that restart
+ ;; test functions are respected when RESTART is a symbol, but not
+ ;; when RESTART is a RESTART instance.
+ ;;
+ ;; Without disabling test functions for the RESTART instance case,
+ ;; the following problem would arise:
+ ;;
+ ;; (restart-case
+ ;; (handler-bind
+ ;; ((some-condition (lambda (c)
+ ;; (invoke-restart (find-restart 'foo c)) ; a)
+ ;; (invoke-restart 'foo) ; b)
+ ;; )))
+ ;; (signal 'some-condition))
+ ;; (foo ()
+ ;; :test (lambda (c) (typep c 'some-condition))))
+ ;;
+ ;; In case a), INVOKE-RESTART receives the RESTART instance, but
+ ;; cannot supply the condition instance needed by the test. In case
+ ;; b) INVOKE-RESTART calls FIND-RESTART, but again cannot supply the
+ ;; condition instance. As a result, the restart would be impossible
+ ;; the invoke.
+ (let ((real-restart (find-restart-or-control-error
+ restart nil (symbolp restart))))
(apply (restart-function real-restart) values)))
+(defun interactive-restart-arguments (real-restart)
+ (let ((interactive-function (restart-interactive-function real-restart)))
+ (if interactive-function
+ (funcall interactive-function)
+ '())))
+
(defun invoke-restart-interactively (restart)
#!+sb-doc
"Calls the function associated with the given restart, prompting for any
necessary arguments. If the argument restart is not a restart or a
- currently active non-nil restart name, then a control-error is signalled."
- (/show "entering INVOKE-RESTART-INTERACTIVELY" restart)
- (let ((real-restart (find-restart restart)))
- (unless real-restart
- (error 'simple-control-error
- :format-control "Restart ~S is not active."
- :format-arguments (list restart)))
- (/show (restart-name real-restart))
- (/show0 "falling through to APPLY of RESTART-FUNCTION")
- (apply (restart-function real-restart)
- (let ((interactive-function
- (restart-interactive-function real-restart)))
- (if interactive-function
- (funcall interactive-function)
- '())))))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-;;; Wrap the RESTART-CASE expression in a WITH-CONDITION-RESTARTS if
-;;; appropriate. Gross, but it's what the book seems to say...
-(defun munge-restart-case-expression (expression data)
- (let ((exp (macroexpand expression)))
- (if (consp exp)
- (let* ((name (car exp))
- (args (if (eq name 'cerror) (cddr exp) (cdr exp))))
- (if (member name '(signal error cerror warn))
- (once-only ((n-cond `(coerce-to-condition
- ,(first args)
- (list ,@(rest args))
- ',(case name
- (warn 'simple-warning)
- (signal 'simple-condition)
- (t 'simple-error))
- ',name)))
- `(with-condition-restarts
- ,n-cond
- (list ,@(mapcar (lambda (da)
- `(find-restart ',(nth 0 da)))
- data))
- ,(if (eq name 'cerror)
- `(cerror ,(second expression) ,n-cond)
- `(,name ,n-cond))))
- expression))
- expression)))
-) ; EVAL-WHEN
-
-;;; FIXME: I did a fair amount of rearrangement of this code in order to
-;;; get WITH-KEYWORD-PAIRS to work cleanly. This code should be tested..
-(defmacro restart-case (expression &body clauses)
- #!+sb-doc
- "(RESTART-CASE form
- {(case-name arg-list {keyword value}* body)}*)
- The form is evaluated in a dynamic context where the clauses have special
- meanings as points to which control may be transferred (see INVOKE-RESTART).
- When clauses contain the same case-name, FIND-RESTART will find the first
- such clause. If Expression is a call to SIGNAL, ERROR, CERROR or WARN (or
- macroexpands into such) then the signalled condition will be associated with
- the new restarts."
- (flet ((transform-keywords (&key report interactive test)
- (let ((result '()))
- (when report
- (setq result (list* (if (stringp report)
- `#'(lambda (stream)
- (write-string ,report stream))
- `#',report)
- :report-function
- result)))
- (when interactive
- (setq result (list* `#',interactive
- :interactive-function
- result)))
- (when test
- (setq result (list* `#',test :test-function result)))
- (nreverse result)))
- (parse-keyword-pairs (list keys)
- (do ((l list (cddr l))
- (k '() (list* (cadr l) (car l) k)))
- ((or (null l) (not (member (car l) keys)))
- (values (nreverse k) l)))))
- (let ((block-tag (gensym))
- (temp-var (gensym))
- (data
- (macrolet (;; KLUDGE: This started as an old DEFMACRO
- ;; WITH-KEYWORD-PAIRS general utility, which was used
- ;; only in this one place in the code. It was translated
- ;; literally into this MACROLET in order to avoid some
- ;; cross-compilation bootstrap problems. It would almost
- ;; certainly be clearer, and it would certainly be more
- ;; concise, to do a more idiomatic translation, merging
- ;; this with the TRANSFORM-KEYWORDS logic above.
- ;; -- WHN 19990925
- (with-keyword-pairs ((names expression) &body forms)
- (let ((temp (member '&rest names)))
- (unless (= (length temp) 2)
- (error "&REST keyword is ~:[missing~;misplaced~]."
- temp))
- (let* ((key-vars (ldiff names temp))
- (keywords (mapcar #'keywordicate key-vars))
- (key-var (gensym))
- (rest-var (cadr temp)))
- `(multiple-value-bind (,key-var ,rest-var)
- (parse-keyword-pairs ,expression ',keywords)
- (let ,(mapcar (lambda (var keyword)
- `(,var (getf ,key-var
- ,keyword)))
- key-vars keywords)
- ,@forms))))))
- (mapcar (lambda (clause)
- (with-keyword-pairs ((report interactive test
- &rest forms)
- (cddr clause))
- (list (car clause) ;name=0
- (gensym) ;tag=1
- (transform-keywords :report report ;keywords=2
- :interactive interactive
- :test test)
- (cadr clause) ;bvl=3
- forms))) ;body=4
- clauses))))
- `(block ,block-tag
- (let ((,temp-var nil))
- (tagbody
- (restart-bind
- ,(mapcar (lambda (datum)
- (let ((name (nth 0 datum))
- (tag (nth 1 datum))
- (keys (nth 2 datum)))
- `(,name #'(lambda (&rest temp)
- (setq ,temp-var temp)
- (go ,tag))
- ,@keys)))
- data)
- (return-from ,block-tag
- ,(munge-restart-case-expression expression data)))
- ,@(mapcan (lambda (datum)
- (let ((tag (nth 1 datum))
- (bvl (nth 3 datum))
- (body (nth 4 datum)))
- (list tag
- `(return-from ,block-tag
- (apply (lambda ,bvl ,@body)
- ,temp-var)))))
- data)))))))
-
-(defmacro with-simple-restart ((restart-name format-string
- &rest format-arguments)
- &body forms)
- #!+sb-doc
- "(WITH-SIMPLE-RESTART (restart-name format-string format-arguments)
- body)
- If restart-name is not invoked, then all values returned by forms are
- returned. If control is transferred to this restart, it immediately
- returns the values NIL and T."
- `(restart-case
- ;; If there's just one body form, then don't use PROGN. This allows
- ;; RESTART-CASE to "see" calls to ERROR, etc.
- ,(if (= (length forms) 1) (car forms) `(progn ,@forms))
- (,restart-name ()
- :report (lambda (stream)
- (format stream ,format-string ,@format-arguments))
- (values nil t))))
+ currently active non-NIL restart name, then a CONTROL-ERROR is signalled."
+ (let* ((real-restart (find-restart-or-control-error restart))
+ (args (interactive-restart-arguments real-restart)))
+ (apply (restart-function real-restart) args)))
\f
-;;;; HANDLER-BIND
-
-(defvar *handler-clusters* nil)
-
-(defmacro handler-bind (bindings &body forms)
- #!+sb-doc
- "(HANDLER-BIND ( {(type handler)}* ) body)
- Executes body in a dynamic context where the given handler bindings are
- in effect. Each handler must take the condition being signalled as an
- argument. The bindings are searched first to last in the event of a
- signalled condition."
- (let ((member-if (member-if (lambda (x)
- (not (proper-list-of-length-p x 2)))
- bindings)))
- (when member-if
- (error "ill-formed handler binding: ~S" (first member-if))))
- `(let ((*handler-clusters*
- (cons (list ,@(mapcar (lambda (x) `(cons ',(car x) ,(cadr x)))
- bindings))
- *handler-clusters*)))
- (multiple-value-prog1
- (progn
- ,@forms)
- ;; Wait for any float exceptions.
- #!+x86 (float-wait))))
-\f
-;;;; HANDLER-CASE
-
-(defmacro handler-case (form &rest cases)
- "(HANDLER-CASE form
- { (type ([var]) body) }* )
- Execute FORM in a context with handlers established for the condition
- types. A peculiar property allows type to be :NO-ERROR. If such a clause
- occurs, and form returns normally, all its values are passed to this clause
- as if by MULTIPLE-VALUE-CALL. The :NO-ERROR clause accepts more than one
- var specification."
-
- ;; FIXME: Replacing CADR, CDDDR and friends with DESTRUCTURING-BIND
- ;; and names for the subexpressions would make it easier to
- ;; understand the code below.
- (let ((no-error-clause (assoc ':no-error cases)))
- (if no-error-clause
- (let ((normal-return (make-symbol "normal-return"))
- (error-return (make-symbol "error-return")))
- `(block ,error-return
- (multiple-value-call (lambda ,@(cdr no-error-clause))
- (block ,normal-return
- (return-from ,error-return
- (handler-case (return-from ,normal-return ,form)
- ,@(remove no-error-clause cases)))))))
- (let ((tag (gensym))
- (var (gensym))
- (annotated-cases (mapcar (lambda (case) (cons (gensym) case))
- cases)))
- `(block ,tag
- (let ((,var nil))
- (declare (ignorable ,var))
- (tagbody
- (handler-bind
- ,(mapcar (lambda (annotated-case)
- (list (cadr annotated-case)
- `(lambda (temp)
- ,(if (caddr annotated-case)
- `(setq ,var temp)
- '(declare (ignore temp)))
- (go ,(car annotated-case)))))
- annotated-cases)
- (return-from ,tag
- #!-x86 ,form
- #!+x86 (multiple-value-prog1 ,form
- ;; Need to catch FP errors here!
- (float-wait))))
- ,@(mapcan
- (lambda (annotated-case)
- (list (car annotated-case)
- (let ((body (cdddr annotated-case)))
- `(return-from
- ,tag
- ,(cond ((caddr annotated-case)
- `(let ((,(caaddr annotated-case)
- ,var))
- ,@body))
- ((not (cdr body))
- (car body))
- (t
- `(progn ,@body)))))))
- annotated-cases))))))))
-\f
-;;;; helper functions for restartable error handling which couldn't be
-;;;; defined 'til now 'cause they use the RESTART-CASE macro
-
-(defun assert-error (assertion places datum &rest arguments)
+(defun assert-error (assertion args-and-values places datum &rest arguments)
(let ((cond (if datum
- (coerce-to-condition datum
- arguments
- 'simple-error
- 'error)
- (make-condition 'simple-error
- :format-control "The assertion ~S failed."
- :format-arguments (list assertion)))))
+ (coerce-to-condition
+ datum arguments 'simple-error 'error)
+ (make-condition
+ 'simple-error
+ :format-control "~@<The assertion ~S failed~:[.~:; ~
+ with ~:*~{~{~S = ~S~}~^, ~}.~]~:@>"
+ :format-arguments (list assertion args-and-values)))))
(restart-case
- (error cond)
+ (error cond)
(continue ()
- :report (lambda (stream)
- (format stream "Retry assertion")
- (if places
- (format stream
- " with new value~P for ~{~S~^, ~}."
- (length places)
- places)
- (format stream ".")))
- nil))))
+ :report (lambda (stream)
+ (format stream "Retry assertion")
+ (if places
+ (format stream " with new value~P for ~{~S~^, ~}."
+ (length places) places)
+ (format stream ".")))
+ nil))))
;;; READ-EVALUATED-FORM is used as the interactive method for restart cases
;;; setup by the Common Lisp "casing" (e.g., CCASE and CTYPECASE) macros
;;; and by CHECK-TYPE.
-(defun read-evaluated-form ()
- (format *query-io* "~&Type a form to be evaluated:~%")
+(defun read-evaluated-form (&optional (prompt-control nil promptp)
+ &rest prompt-args)
+ (apply #'format *query-io*
+ (if promptp prompt-control "~&Type a form to be evaluated: ")
+ prompt-args)
+ (finish-output *query-io*)
(list (eval (read *query-io*))))
(defun check-type-error (place place-value type type-string)
- (let ((cond (if type-string
- (make-condition 'simple-type-error
- :datum place
- :expected-type type
- :format-control
- "The value of ~S is ~S, which is not ~A."
- :format-arguments (list place
- place-value
- type-string))
- (make-condition 'simple-type-error
- :datum place
- :expected-type type
- :format-control
- "The value of ~S is ~S, which is not of type ~S."
- :format-arguments (list place
- place-value
- type)))))
- (restart-case (error cond)
+ (let ((condition
+ (make-condition
+ 'simple-type-error
+ :datum place-value
+ :expected-type type
+ :format-control
+ "The value of ~S is ~S, which is not ~:[of type ~S~;~:*~A~]."
+ :format-arguments (list place place-value type-string type))))
+ (restart-case (error condition)
(store-value (value)
- :report (lambda (stream)
- (format stream "Supply a new value for ~S." place))
- :interactive read-evaluated-form
- value))))
+ :report (lambda (stream)
+ (format stream "Supply a new value for ~S." place))
+ :interactive read-evaluated-form
+ value))))
+
+(defun case-failure (name value keys)
+ (error 'case-failure
+ :name name
+ :datum value
+ :expected-type (if (eq name 'ecase)
+ `(member ,@keys)
+ `(or ,@keys))
+ :possibilities keys))
(defun case-body-error (name keyform keyform-value expected-type keys)
(restart-case
(error 'case-failure
- :name name
- :datum keyform-value
- :expected-type expected-type
- :possibilities keys)
+ :name name
+ :datum keyform-value
+ :expected-type expected-type
+ :possibilities keys)
(store-value (value)
:report (lambda (stream)
- (format stream "Supply a new value for ~S." keyform))
+ (format stream "Supply a new value for ~S." keyform))
:interactive read-evaluated-form
value)))
projects / sbcl.git / blobdiff