projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
1.0.12.33: Have foreign.test.sh create .so files under the test directory
[sbcl.git]
/
src
/
code
/
condition.lisp
diff --git
a/src/code/condition.lisp
b/src/code/condition.lisp
index
44270bb
..
f9184fb
100644
(file)
--- a/
src/code/condition.lisp
+++ b/
src/code/condition.lisp
@@
-619,9
+619,6
@@
(define-condition simple-error (simple-condition error) ())
(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)
(define-condition storage-condition (serious-condition) ())
(define-condition type-error (error)
@@
-634,6
+631,8
@@
(type-error-datum condition)
(type-error-expected-type condition)))))
(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) ())
(define-condition simple-type-error (simple-condition type-error) ())
(define-condition program-error (error) ())
@@
-815,7
+814,8
@@
<http://sbcl.sourceforge.net/>.~:@>"
'((fmakunbound 'compile))))))
<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
;;; 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)))
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
(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)
(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)