Re: Is this a good use for restart-bind?

Alan Crowe <alan@xxxxxxxxxxxxxxxxxxxxxxx> 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 * peter@xxxxxxxxxxxxxxx
Gigamonkeys Consulting * http://www.gigamonkeys.com/
Practical Common Lisp * http://www.gigamonkeys.com/book/
.

Relevant Pages