1.0.13.20: added SB-EXT:*EXIT-HOOKS*

[sbcl.git] / src / code / condition.lisp

diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index 44270bb..d2762ec 100644 (file)
--- 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) ())
@@ -815,7 +814,8 @@
               <http://sbcl.sourceforge.net/>.~:@>"
              '((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
@@ -968,6 +968,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 "~@<Implicitly creating new generic function ~S.~:@>"
+             (implicit-generic-function-name condition)))))
+
 (define-condition extension-failure (reference-condition simple-error)
   ())
 
@@ -1287,15 +1294,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)