(defun coerce-to-condition (datum args default-type supertype)
"This function implements the semantics of CL \"condition designators\". It makes a condition, given a DATUM (which may be a symbol, format control, or condition), and ARGS (a list of arguments). See CLHS 9.1.2.1 for more specifics.
DEFAULT-TYPE is the type of objects that should be constructed when DATUM is a format control. SUPERTYPE is a type that should be a supertype of the types of all conditions returned by this function."
(etypecase datum
;; just a symbol, not a class, says 9.1.2.1. why? who knows!
;; and of course (deftype foo (...args...) ... (find-class 'some-kind-of-condition))
;; (error '(foo ...) ...) is right out.
(symbol
(if (subtypep datum supertype)
(apply #'make-condition datum args)
(error "~s is not a subclass of ~s, and can't be used as one" datum supertype)))
;; functions are also format controls.
((or function string) (make-condition default-type :format-control datum :format-arguments args))
(condition
;; in compiler-macro i have a check here, but it uses an auxilary macro
;; that isn't totally necessary
(unless (null args)
(cerror "Ignore the extra arguments."
"Passed a condition to ~s, but passed arguments ~s as well."
'coerce-to-condition args))
datum)))
This is intended to be used for things like ERROR or WARN that have different defaults. E.g.
;; Write the code here.
(defun coerce-to-condition (datum args default-type supertype) "This function implements the semantics of CL \"condition designators\". It makes a condition, given a DATUM (which may be a symbol, format control, or condition), and ARGS (a list of arguments). See CLHS 9.1.2.1 for more specifics.
DEFAULT-TYPE is the type of objects that should be constructed when DATUM is a format control. SUPERTYPE is a type that should be a supertype of the types of all conditions returned by this function." (etypecase datum ;; just a symbol, not a class, says 9.1.2.1. why? who knows! ;; and of course (deftype foo (...args...) ... (find-class 'some-kind-of-condition)) ;; (error '(foo ...) ...) is right out. (symbol (if (subtypep datum supertype) (apply #'make-condition datum args) (error "~s is not a subclass of ~s, and can't be used as one" datum supertype))) ;; functions are also format controls. ((or function string) (make-condition default-type :format-control datum :format-arguments args)) (condition ;; in compiler-macro i have a check here, but it uses an auxilary macro ;; that isn't totally necessary (unless (null args) (cerror "Ignore the extra arguments." "Passed a condition to ~s, but passed arguments ~s as well." 'coerce-to-condition args)) datum)))
This is intended to be used for things like ERROR or WARN that have different defaults. E.g.
(defun style-warn (datum &rest args) (warn (coerce-to-condition datum args 'simple-style-warning 'style-warning)))
And then (style-warn "what the fuck are you doing, ~s" name) and (style-warn 'overuse-of-expletives-in-comments :offender 'fuck) work.
Provides: coerce-to-condition Requires: fucking nothing Author: Bike License: PD