X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/7702b7bc88a97c15f955f62e8afbc40521ceec7b..e4af0384a9d904782ddb865afc90fb8a9703615c:/src/parser/floc-proto.lisp 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))