;;;; Using restart-bind to offer explanations for errors
;; Basic example: Let us define a version of member
;; that signals an error if it cannot find the item in then list.
(defun known-member (item list)
(let ((search-result (member item list)))
(or search-result
(error "~A was not in ~A." item list))))
;; This code can be rather annoying
#|
(known-member "bob" '("alice" "bob" "carol"))
=> Error in function KNOWN-MEMBER: "bob" was not in ("alice" "bob" "carol").
|#
;; On the other hand, over elaborate error messages are a problem too. The
;; message as written is good for many cases
;; Instead of adding further information to the error message, let us add an explanation option
(defun known-member (item list)
(let ((search-result (member item list)))
(restart-bind ((explain (lambda()
(let ((search-result (member item
list
:test #'equalp)))
(if search-result
(format *query-io*
"~&~S is EQUALP to ~S ~
but KNOWN-MEMBER uses EQL."
item (car search-result))
(let ((search-result
(member item
list
:test (lambda(x y)
(and (typep x 'sequence)
(typep y 'sequence)
(not (mismatch x y
:test #'equalp)))))))
(if search-result
(format *query-io*
"~&~S is a ~S but ~S is a ~S."
item (type-of item)
(car search-result)
(type-of (car search-result)))
(format *query-io*
"~&Could not find anything close to ~S in the list.~
~%So no local explanation in terms of the item being ~
in the list,·@
but the equality test being too strict."
item))))))
:report-function (lambda(stream)
(format stream "Examine list for near misses."))))
(or search-result
(error "~S was not in ~S." item list)))))
;; If the error message baffles, the explanation sometimes helps
#|
CL-USER> (known-member #(5 7) '((3 9)(4 8)(5 7)(6 6)))
#(5 7) is a (SIMPLE-VECTOR 2) but (5 7) is a CONS.
CL-USER> (known-member "bob" '("alice" "bob" "carol"))
"bob" is EQUALP to "bob" but KNOWN-MEMBER uses EQL.
|#
;; This occurred to me in the course of designing a macro.
;; What should it say if it could not expand because of an error
;; parsing the argument? Usually one wants the error message to be brief,
;; but if the macro is complicated one sometimes wants to ask for more detail
Alan Crowe
Edinburgh
Scotland
Alan Crowe <····@cawtech.freeserve.co.uk> writes:
> ;;;; Using restart-bind to offer explanations for errors
This seems reasonable. Another option would be to figure out how to
encode enough information into a condition object be able to generate
the explanation elsewhere. This would have the advantage that if you
have the same kind of error (i.e. that would be explained in the same
way) signalled in different places you just have to signal the error
there and can then wrap your whole application, at a much higher
level, with restarts that provides these lengthy explanations.
For a simple example (untested):
(define-condition needs-explanation ()
((name :initarg :name :reader name-of)
(args :initarg :args :reader args-of)))
(defgeneric explain (name flavor args))
(defmacro define-explainer (name flavor (&rest parameters) &body body)
(with-gensyms (n f args)
`(defmethod explain ((,n (eql ',name)) (,f (eql ',flavor)) ,args)
(destructuring-bind (,@parameters) ,args
,@body))))
(defmacro with-explanations ((&rest flavors) &body body)
`(handler-bind ((needs-explanation
#'(lambda (e)
(let ((name (name-of e))
(args (args-of e)))
(loop for flavor in ',flavors until (explain name flavor args))))))
,@body))
(defun known-member (item list)
(or (member item list)
(error 'needs-explanation :name 'known-member :args (list item list))))
(define-explainer known-member eql-vs-equal (item list)
(let ((result (member item list :test #'equal)))
(when result
(format *query-io*
"~&~S is EQUALP to ~S but KNOWN-MEMBER uses EQL."
item (car result))
t)))
(define-explainer known-member type-mismatch (item list)
(let ((result
(member item
list
:test (lambda (x y)
(and (typep x 'sequence)
(typep y 'sequence)
(not (mismatch x y :test #'equalp)))))))
(when result
(format *query-io*
"~&~S is a ~S but ~S is a ~S."
item (type-of item)
(car result)
(type-of (car result)))
t)))
Then use it like this.
(defun main-app ()
(with-explanations (eql-vs-equal type-mismatch)
(stuff)))
(defun stuff ()
(many-layers-down))
(defun many-layers-down ()
;; FORMAT in there to make sure constants *aren't* EQL.
(known-member "bar" (list "foo" (format nil "~a" "bar") "baz")))
Obviously this scheme could be elaborated in various ways.
-Peter
--
Peter Seibel * ·····@gigamonkeys.com
Gigamonkeys Consulting * http://www.gigamonkeys.com/
Practical Common Lisp * http://www.gigamonkeys.com/book/
From: Christophe Rhodes
Subject: Re: Is this a good use for restart-bind?
Date:
Message-ID: <sqy7yqd0xc.fsf@cam.ac.uk>
Peter Seibel <·····@gigamonkeys.com> writes:
> Alan Crowe <····@cawtech.freeserve.co.uk> writes:
>
>> ;;;; Using restart-bind to offer explanations for errors
>
> This seems reasonable. Another option would be to figure out how to
> encode enough information into a condition object be able to generate
> the explanation elsewhere.
This is in fact what SBCL does for its reference conditions, which
generates text of the form
See also:
The ANSI Standard, Macro DEFCONSTANT
The SBCL Manual, Node "Idiosyncrasies"
when SBCL is running at a terminal and someone ends up redefining a
constant incompatibly. If they are running in SLIME, they get
clickable links for the reference sources. At present this isn't done
with non-restarting restarts but through the condition printer
directly.
Christophe
Peter Seibel wrote:
> ;; FORMAT in there to make sure constants *aren't* EQL.
> (known-member "bar" (list "foo" (format nil "~a" "bar") "baz")))
(copy-seq "bar")?