Abandoned atoms work: hardly any performance benefit.
[sod] / src / utilities.lisp
index 769ff5d..bdcdf80 100644 (file)
                                            condition)))
         arguments))
 
+(export '(enclosing-condition enclosed-condition))
+(define-condition enclosing-condition (condition)
+  ((%enclosed-condition :initarg :condition :type condition
+                       :reader enclosed-condition))
+  (:documentation
+   "A condition which encloses another condition
+
+   This is useful if one wants to attach additional information to an
+   existing condition.  The enclosed condition can be obtained using the
+   `enclosed-condition' function.")
+  (:report (lambda (condition stream)
+            (princ (enclosed-condition condition) stream))))
+
+(export 'information)
+(define-condition information (condition)
+  ())
+
+(export 'simple-information)
+(define-condition simple-information (simple-condition information)
+  ())
+
+(export 'info)
+(defun info (datum &rest arguments)
+  "Report some useful diagnostic information.
+
+   Establish a simple restart named `noted', and signal the condition of type
+   `information' designated by DATUM and ARGUMENTS.  Return non-nil if the
+   restart was invoked, otherwise nil."
+  (restart-case
+      (signal (designated-condition 'simple-information datum arguments))
+    (noted () :report "Noted." t)))
+
+(export 'noted)
+(defun noted (&optional condition)
+  "Invoke the `noted' restart, possibly associated with the given CONDITION."
+  (invoke-associated-restart 'noted condition))
+
+(export 'promiscuous-cerror)
+(defun promiscuous-cerror (continue-string datum &rest arguments)
+  "Like standard `cerror', but robust against sneaky changes of conditions.
+
+   It seems that `cerror' (well, at least the version in SBCL) is careful
+   to limit its restart to the specific condition it signalled.  But that's
+   annoying, because `sod-parser:with-default-error-location' substitutes
+   different conditions carrying the error-location information."
+  (restart-case (apply #'error datum arguments)
+    (continue ()
+      :report (lambda (stream)
+               (apply #'format stream continue-string datum arguments))
+      nil)))
+
+(export 'cerror*)
+(defun cerror* (datum &rest arguments)
+  (apply #'promiscuous-cerror "Continue" datum arguments))
+
 ;;;--------------------------------------------------------------------------
 ;;; CLOS hacking.