X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-error.lisp;h=288f3e122a7b667f7cc9d7fcf990195701fcb81f;hb=568214ddf4c8ecc881caec98e20848d017974ec0;hp=f4093cc4ce09d15f3f612a965c51fa4f3c41a187;hpb=d49c71bf00d858efc5796900ca4954fb76ce6402;p=sbcl.git

diff --git a/src/code/target-error.lisp b/src/code/target-error.lisp
index f4093cc..288f3e1 100644
--- a/src/code/target-error.lisp
+++ b/src/code/target-error.lisp
@@ -82,21 +82,21 @@
                    (eq (restart-name x) name)))
              restarts)))
 
-(defun find-restart-or-lose (restart-designator)
-  (let ((real-restart (find-restart restart-designator)))
-    (unless real-restart
+;;; 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)
+  (or (find-restart identifier condition)
       (error 'simple-control-error
-	     :format-control "Restart ~S is not active."
-	     :format-arguments (list restart-designator)))
-    real-restart))
+	     :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-or-lose restart)))
+  (let ((real-restart (find-restart-or-control-error restart)))
     (apply (restart-function real-restart) values)))
 
 (defun interactive-restart-arguments (real-restart)
@@ -109,18 +109,11 @@
   #!+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."
-  (let* ((real-restart (find-restart-or-lose restart))
+   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)))
 
-
-
-
-
-;;;; 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)
   (let ((cond (if datum
 		(coerce-to-condition datum
@@ -151,24 +144,15 @@
   (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))