;;; single argument that's directly usable by all the other routines.
(defun coerce-to-condition (datum arguments default-type fun-name)
(cond ((typep datum 'condition)
;;; single argument that's directly usable by all the other routines.
(defun coerce-to-condition (datum arguments default-type fun-name)
(cond ((typep datum 'condition)
- datum)
- ((symbolp datum) ; roughly, (SUBTYPEP DATUM 'CONDITION)
- (apply #'make-condition datum arguments))
- ((or (stringp datum) (functionp datum))
- (make-condition default-type
- :format-control datum
- :format-arguments arguments))
- (t
- (error 'simple-type-error
- :datum datum
- :expected-type '(or symbol string)
- :format-control "bad argument to ~S: ~S"
- :format-arguments (list fun-name datum)))))
+ datum)
+ ((symbolp datum) ; roughly, (SUBTYPEP DATUM 'CONDITION)
+ (apply #'make-condition datum arguments))
+ ((or (stringp datum) (functionp datum))
+ (make-condition default-type
+ :format-control datum
+ :format-arguments arguments))
+ (t
+ (error 'simple-type-error
+ :datum datum
+ :expected-type '(or symbol string)
+ :format-control "bad argument to ~S: ~S"
+ :format-arguments (list fun-name datum)))))
(lambda (condition stream)
(format stream "~@<~S fell through ~S expression. ~
~:_Wanted one of ~:S.~:>"
(lambda (condition stream)
(format stream "~@<~S fell through ~S expression. ~
~:_Wanted one of ~:S.~:>"
- (type-error-datum condition)
- (case-failure-name condition)
- (case-failure-possibilities condition)))))
+ (type-error-datum condition)
+ (case-failure-name condition)
+ (case-failure-possibilities condition)))))
(define-condition compiled-program-error (program-error)
((message :initarg :message :reader program-error-message)
(source :initarg :source :reader program-error-source))
(:report (lambda (condition stream)
(define-condition compiled-program-error (program-error)
((message :initarg :message :reader program-error-message)
(source :initarg :source :reader program-error-source))
(:report (lambda (condition stream)
(define-condition simple-control-error (simple-condition control-error) ())
(define-condition simple-file-error (simple-condition file-error) ())
(define-condition simple-control-error (simple-condition control-error) ())
(define-condition simple-file-error (simple-condition file-error) ())