X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcondition.lisp;h=594b3ac33eb2874517ad399d5c82a9058df2de43;hb=05e9b542c5700416b8fd9f3ba9bb91bb6ab84b3a;hp=6e04cdacb3605d5931e14aa805f7801236a77886;hpb=42702bd5e2af3e0042c9f27372c6f5d92335df12;p=sbcl.git
diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index 6e04cda..594b3ac 100644
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -619,9 +619,6 @@
(define-condition simple-error (simple-condition error) ())
-;;; not specified by ANSI, but too useful not to have around.
-(define-condition simple-style-warning (simple-condition style-warning) ())
-
(define-condition storage-condition (serious-condition) ())
(define-condition type-error (error)
@@ -634,6 +631,8 @@
(type-error-datum condition)
(type-error-expected-type condition)))))
+;;; not specified by ANSI, but too useful not to have around.
+(define-condition simple-style-warning (simple-condition style-warning) ())
(define-condition simple-type-error (simple-condition type-error) ())
(define-condition program-error (error) ())
@@ -779,8 +778,7 @@
(class-name (class-of condition))
pos lineno colno error-stream)
(when simple
- (format stream ":~2I~_")
- (format stream
+ (format stream ":~2I~_~?"
(simple-condition-format-control condition)
(simple-condition-format-arguments condition)))))))
@@ -816,7 +814,8 @@
.~:@>"
'((fmakunbound 'compile))))))
-(define-condition simple-storage-condition (storage-condition simple-condition) ())
+(define-condition simple-storage-condition (storage-condition simple-condition)
+ ())
;;; a condition for use in stubs for operations which aren't supported
;;; on some platforms
@@ -901,6 +900,9 @@
(unless (null (cdr rs))
(terpri s)))))))
+(define-condition simple-reference-error (reference-condition simple-error)
+ ())
+
(define-condition duplicate-definition (reference-condition warning)
((name :initarg :name :reader duplicate-definition-name))
(:report (lambda (c s)
@@ -969,6 +971,13 @@
(format-args-mismatch simple-style-warning)
())
+(define-condition implicit-generic-function-warning (style-warning)
+ ((name :initarg :name :reader implicit-generic-function-name))
+ (:report
+ (lambda (condition stream)
+ (format stream "~@"
+ (implicit-generic-function-name condition)))))
+
(define-condition extension-failure (reference-condition simple-error)
())
@@ -1288,15 +1297,16 @@ the values returned by the form as a list. No associated restarts."))
CONTROL-ERROR if none exists."
(invoke-restart (find-restart-or-control-error 'muffle-warning condition)))
+(defun try-restart (name condition &rest arguments)
+ (let ((restart (find-restart name condition)))
+ (when restart
+ (apply #'invoke-restart restart arguments))))
+
(macrolet ((define-nil-returning-restart (name args doc)
#!-sb-doc (declare (ignore doc))
`(defun ,name (,@args &optional condition)
#!+sb-doc ,doc
- ;; FIXME: Perhaps this shared logic should be pulled out into
- ;; FLET MAYBE-INVOKE-RESTART? See whether it shrinks code..
- (let ((restart (find-restart ',name condition)))
- (when restart
- (invoke-restart restart ,@args))))))
+ (try-restart ',name condition ,@args))))
(define-nil-returning-restart continue ()
"Transfer control to a restart named CONTINUE, or return NIL if none exists.")
(define-nil-returning-restart store-value (value)