src/parser/floc-proto.lisp, src/utilities.lisp: New `information' condition.

[sod] / src / parser / floc-proto.lisp

diff --git a/src/parser/floc-proto.lisp b/src/parser/floc-proto.lisp
index e3dca32..f65ed73 100644 (file)
--- a/src/parser/floc-proto.lisp
+++ b/src/parser/floc-proto.lisp
@@ -83,6 +83,10 @@
     (condition-with-location enclosing-condition)
   ())
 
+(export 'information)
+(define-condition information (condition)
+  ())
+
 (export 'error-with-location)
 (define-condition error-with-location (condition-with-location error)
   ())
@@ -91,6 +95,11 @@
 (define-condition warning-with-location (condition-with-location warning)
   ())
 
+(export 'information-with-location)
+(define-condition information-with-location
+    (condition-with-location information)
+  ())
+
 (export 'enclosing-error-with-location)
 (define-condition enclosing-error-with-location
     (enclosing-condition-with-location error)
@@ -101,6 +110,11 @@
     (enclosing-condition-with-location warning)
   ())
 
+(export 'enclosing-information-with-location)
+(define-condition enclosing-information-with-location
+    (enclosing-condition-with-location information)
+  ())
+
 (export 'simple-condition-with-location)
 (define-condition simple-condition-with-location
     (condition-with-location simple-condition)
@@ -116,6 +130,26 @@
     (warning-with-location simple-warning)
   ())
 
+(export 'simple-information)
+(define-condition simple-information (simple-condition information)
+  ())
+
+(export '(info noted))
+(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 'simple-information-with-location)
+(define-condition simple-information-with-location
+    (information-with-location simple-information)
+  ())
+
 ;;;--------------------------------------------------------------------------
 ;;; Reporting errors.
 
@@ -128,6 +162,7 @@
     with-location' suitable to enclose CONDITION.")
   (:method ((condition error)) 'enclosing-error-with-location)
   (:method ((condition warning)) 'enclosing-warning-with-location)
+  (:method ((condition information)) 'enclosing-information-with-location)
   (:method ((condition condition)) 'enclosing-condition-with-location))
 
 (export 'make-condition-with-location)
@@ -196,6 +231,13 @@
               'simple-warning-with-location
               floc datum arguments)))
 
+(export 'info-with-location)
+(defun info-with-location (floc datum &rest arguments)
+  "Report some information with attached location information."
+  (info (apply #'make-condition-with-location
+              'simple-information-with-location
+              floc datum arguments)))
+
 (defun my-cerror (continue-string datum &rest arguments)
   "Like standard `cerror', but robust against sneaky changes of conditions.
 
@@ -306,7 +348,12 @@
                                  (file-location warning)
                                  warning)
                          (incf warnings)
-                         (invoke-restart 'muffle-warning))))
+                         (invoke-restart 'muffle-warning)))
+              (information (lambda (info)
+                             (format *error-output* "~&~A: Info: ~A~%"
+                                     (file-location info)
+                                     info)
+                         (invoke-restart 'noted))))
            (values (funcall thunk)
                    errors
                    warnings)))