X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fcondition.lisp;h=f9184fbd1e78c79736fcaebb11a2d1929c39f082;hb=6a0601ab48635465ad3400c290e5cfbca28e5367;hp=44270bb6851f2e11eefa23aaa78757af87550e42;hpb=134fa6b3f7c5f4bb0652e74227d940a9e7a83563;p=sbcl.git diff --git a/src/code/condition.lisp b/src/code/condition.lisp index 44270bb..f9184fb 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) ()) @@ -815,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 @@ -1287,15 +1287,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)