X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/e2838dc5e1dbdc1558d3ec225fbc9fdd581b5b26..e046c3f65a8f7241889fb9b6005aac21e2aad1a8:/src/utilities.lisp?ds=sidebyside

diff --git a/src/utilities.lisp b/src/utilities.lisp
index 1d58fa3..72423fd 100644
--- a/src/utilities.lisp
+++ b/src/utilities.lisp
@@ -833,6 +833,30 @@
 		(setf (,to object) value))))))
 
 ;;;--------------------------------------------------------------------------
+;;; Condition and error utilities.
+
+(export 'designated-condition)
+(defun designated-condition (default-type datum arguments
+			     &key allow-pointless-arguments)
+  "Return the condition designated by DATUM and ARGUMENTS.
+
+   DATUM and ARGUMENTS together are a `condition designator' of (some
+   supertype of) DEFAULT-TYPE; return the condition so designated."
+  (typecase datum
+    (condition
+     (unless (or allow-pointless-arguments (null arguments))
+       (error "Argument list provided with specific condition"))
+     datum)
+    (symbol
+     (apply #'make-condition datum arguments))
+    ((or string function)
+     (make-condition default-type
+		     :format-control datum
+		     :format-arguments arguments))
+    (t
+     (error "Unexpected condition designator datum ~S" datum))))
+
+;;;--------------------------------------------------------------------------
 ;;; CLOS hacking.
 
 (export 'default-slot)