From: Mark Wooding Date: Sat, 3 Aug 2019 14:07:39 +0000 (+0100) Subject: src/parser/floc-proto.lisp, src/utilities.lisp: Move generic condition stuff. X-Git-Url: https://git.distorted.org.uk/~mdw/sod/commitdiff_plain/c884ec24084f0c2ad184ba2372fb78f501cdc165 src/parser/floc-proto.lisp, src/utilities.lisp: Move generic condition stuff. Move the non-location-specific condition machinery from `sod-parser' to `sod-utilities' where it makes more sense. Also, give `my-cerror' a more sensible name (`promiscuous-cerror') now that it needs to be exported. --- diff --git a/doc/SYMBOLS b/doc/SYMBOLS index 6f230a2..023bda6 100644 --- a/doc/SYMBOLS +++ b/doc/SYMBOLS @@ -1622,14 +1622,11 @@ Package `sod-parser' floc-proto.lisp base-lexer-error class base-syntax-error class - cerror* function cerror*-with-location function cerror-with-location function classify-condition generic condition-with-location class count-and-report-errors macro - enclosed-condition generic - enclosing-condition class enclosing-condition-with-location class enclosing-condition-with-location-type generic enclosing-error-with-location class @@ -1641,20 +1638,16 @@ floc-proto.lisp file-location-filename function file-location-line function file-location-p function - info function info-with-location function - information class information-with-location class make-condition-with-location function make-file-location function - noted function parser-error class parser-error-expected generic parser-error-found generic report-parser-error function simple-condition-with-location class simple-error-with-location class - simple-information class simple-information-with-location class simple-lexer-error class simple-syntax-error class @@ -1794,9 +1787,9 @@ cl:t sb-pcl::slot-object cl:condition condition-with-location - enclosing-condition-with-location [enclosing-condition] + enclosing-condition-with-location [sod-utilities:enclosing-condition] enclosing-error-with-location [cl:error] - enclosing-information-with-location [information] + enclosing-information-with-location [sod-utilities:information] enclosing-warning-with-location [cl:warning] error-with-location [cl:error] base-lexer-error @@ -1806,21 +1799,21 @@ cl:t simple-error-with-location [cl:simple-error] simple-lexer-error [base-lexer-error] simple-syntax-error [base-syntax-error] - information-with-location [information] - simple-information-with-location [simple-information] + information-with-location [sod-utilities:information] + simple-information-with-location [sod-utilities:simple-information] simple-condition-with-location [cl:simple-condition] warning-with-location [cl:warning] simple-warning-with-location [cl:simple-warning] - enclosing-condition + sod-utilities:enclosing-condition enclosing-condition-with-location [condition-with-location] enclosing-error-with-location [cl:error] - enclosing-information-with-location [information] + enclosing-information-with-location [sod-utilities:information] enclosing-warning-with-location [cl:warning] - information + sod-utilities:information enclosing-information-with-location [enclosing-condition-with-location] information-with-location [condition-with-location] - simple-information-with-location [simple-information] - simple-information [cl:simple-condition] + simple-information-with-location [sod-utilities:simple-information] + sod-utilities:simple-information [cl:simple-condition] simple-information-with-location [information-with-location] cl:serious-condition cl:error @@ -1844,7 +1837,7 @@ cl:t simple-error-with-location [error-with-location] simple-lexer-error [base-lexer-error] simple-syntax-error [base-syntax-error] - simple-information [information] + sod-utilities:simple-information [sod-utilities:information] simple-information-with-location [information-with-location] cl:simple-warning [cl:warning] simple-warning-with-location [warning-with-location] @@ -1961,14 +1954,12 @@ classify-condition cl:warning base-lexer-error base-syntax-error - information -enclosed-condition - enclosing-condition + sod-utilities:information enclosing-condition-with-location-type cl:condition cl:error cl:warning - information + sod-utilities:information expand-parser-form t (eql cl:and) t t (eql cl:list) t @@ -2299,6 +2290,7 @@ utilities.lisp awhen macro backtrack-position function categorize macro + cerror* function compose function copy-instance function copy-instance-using-class generic @@ -2309,12 +2301,16 @@ utilities.lisp designated-condition function distinguished-point-shortest-paths function dosequence macro + enclosed-condition generic + enclosing-condition class sb-mop:eql-specializer class sb-mop:eql-specializer-object generic find-duplicates function frob-identifier function sb-mop:generic-function-methods generic setf inconsistent-merge-error class + info function + information class instance-initargs generic invoke-associated-restart function it @@ -2331,12 +2327,15 @@ utilities.lisp merge-error-present-function generic merge-lists function sb-mop:method-specializers generic + noted function once-only macro parse-body function partial-order-minima function print-ugly-stuff function + promiscuous-cerror function ref function setf simple-control-error class + simple-information class symbolicate function update-position function whitespace-char-p function @@ -2347,6 +2346,9 @@ Classes: cl:t sb-pcl::slot-object cl:condition + enclosing-condition + information + simple-information [cl:simple-condition] cl:serious-condition cl:error cl:control-error @@ -2357,6 +2359,7 @@ cl:t cl:simple-condition cl:simple-error [cl:error] simple-control-error [cl:control-error] + simple-information [information] cl:standard-object sb-mop:metaobject sb-mop:specializer @@ -2370,8 +2373,14 @@ cl:t loc Methods: +sod-parser:classify-condition + information copy-instance-using-class cl:standard-class t +enclosed-condition + enclosing-condition +sod-parser:enclosing-condition-with-location-type + information sb-mop:eql-specializer-object sb-mop:eql-specializer sb-mop:generic-function-methods diff --git a/doc/misc.tex b/doc/misc.tex index c253630..05f5619 100644 --- a/doc/misc.tex +++ b/doc/misc.tex @@ -255,6 +255,32 @@ These symbols are defined in the @|sod-utilities| package. {invoke-associated-restart @ @ \&rest @} \end{describe} +\begin{describe*} + {\dhead{cls}{enclosing-condition (condition) \&key :condition} + \dhead{gf}{enclosed-condition @ @> @}} +\end{describe*} + +\begin{describe}{cls}{information (condition) \&key} +\end{describe} + +\begin{describe}{cls} + {simple-information (simple-condition information) \\ \ind + \&key :format-control :format-arguments} +\end{describe} + +\begin{describe*} + {\dhead{fun}{info @ \&rest @ @> @} + \dhead{rst}{noted} + \dhead{fun}{noted \&optional @}} +\end{describe*} + +\begin{describe}{fun} + {promiscuous-cerror @ @ \&rest @} +\end{describe} + +\begin{describe}{fun}{cerror* @ \&rest @} +\end{describe} + \subsection{Very miscellaneous utilities} @@ -284,37 +310,6 @@ These symbols are defined in the @|sod-utilities| package. \end{describe} %%%-------------------------------------------------------------------------- -\section{Condition utilities} \label{sec:misc.condition} - -These symbols are defined in the @|sod-parser| package. - -\begin{describe}{cls}{enclosing-condition (condition) \&key :condition} -\end{describe} - -\begin{describe}{gf} - {enclosed-condition @ @> @} -\end{describe} - -\begin{describe}{cls}{information (condition) \&key} -\end{describe} - -\begin{describe}{cls} - {simple-information (simple-condition information) \\ \ind - \&key :format-control :format-arguments} -\end{describe} - -\begin{describe}{fun}{info @ \&rest @ @> @} -\end{describe} - -\begin{describe*} - {\dhead{rst}{noted} - \dhead{fun}{noted \&optional @}} -\end{describe*} - -\begin{describe}{fun}{cerror* @ \&rest @} -\end{describe} - -%%%-------------------------------------------------------------------------- \section{Option parser} \label{sec:misc.optparse} These symbols are defined in the @|optparse| package. diff --git a/src/parser/floc-proto.lisp b/src/parser/floc-proto.lisp index 9acbfae..0ee952d 100644 --- a/src/parser/floc-proto.lisp +++ b/src/parser/floc-proto.lisp @@ -54,22 +54,6 @@ (:method ((thing file-location)) thing)) ;;;-------------------------------------------------------------------------- -;;; Enclosing conditions. - -(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)))) - -;;;-------------------------------------------------------------------------- ;;; Conditions with location information. (export 'condition-with-location) @@ -83,10 +67,6 @@ (condition-with-location enclosing-condition) ()) -(export 'information) -(define-condition information (condition) - ()) - (export 'error-with-location) (define-condition error-with-location (condition-with-location error) ()) @@ -130,26 +110,6 @@ (warning-with-location simple-warning) ()) -(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 'simple-information-with-location) (define-condition simple-information-with-location (information-with-location simple-information) @@ -243,31 +203,14 @@ '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. - - 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 `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-with-location) (defun cerror-with-location (floc continue-string datum &rest arguments) "Report a continuable error with attached location information." - (my-cerror continue-string + (promiscuous-cerror continue-string (apply #'make-condition-with-location 'simple-error-with-location floc datum arguments))) -(export 'cerror*) -(defun cerror* (datum &rest arguments) - (apply #'my-cerror "Continue" datum arguments)) - (export 'cerror*-with-location) (defun cerror*-with-location (floc datum &rest arguments) (apply #'cerror-with-location floc "Continue" datum arguments)) diff --git a/src/utilities.lisp b/src/utilities.lisp index 769ff5d..bdcdf80 100644 --- a/src/utilities.lisp +++ b/src/utilities.lisp @@ -1039,6 +1039,61 @@ 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.