bug in condition-system implementation

To: cl-error-handling@SU-AI.ARPA

Subject: bug in condition-system implementation

From: Richard Mlynarik <MLY@AI.AI.MIT.EDU>

Date: Thu, 31 Jul 86 12:26 EDT

Sigh. The handlers in CONDITION-BIND were being evaluated in the wrong dynamic
context (they should be evaluated when the condition-bind form is `entered',
not when the handler is invoked.)
The issue came of when handlers should be evaluated up on this list some time
last year, as I recall.
CONDITION-BIND and SIGNAL should read:
(defmacro condition-bind ((&rest condition-handler-bindings) &body body)
"Execute BODY with the specified condition handlers in effect.
Each element of CONDITION-HANDLER-BINDINGS is a list of two elements:
(<conditions> <handler-function>).
<conditions> is not evaluated, and should be either a condition name
or a list of condition names.
<handler-function> is evaluated before BODY is entered to get a function
to call to handle the condition(s)
When a one of the specified conditions is signalled, <handler-function>
is called with the signalled condition as its argument (after any
dynamically more-recent CONDITION-BIND handlers have been called and
\"declined\" the condition.)
<handler-function> may either \"handle\" the condition, by doing some non-local
transfer of control (such as RETURN or THROW) or it may \"decline\" to handle
the condition by simply returning, in which case any previously-established
handlers are successively called. (See SIGNAL)
The first CONDITION-HANDLER-BINDING, somewhat perversely, is established last,
the second penultimately, and so forth, so that textually earlier bindings in
CONDITION-HANDLER-BINDINGS are called on a matching condition before
following handlers are offered it. (The order in which the handlers in
CONDITION-HANDLER-BINDINGS are evaluated is unspecified: not that you should
depend on things like that in any case!)
The values of BODY are returned."
(check-type condition-handler-bindings list)
(flet ((lose (&rest format)
#+lmi (declare (dbg:error-reporter))
(apply #'lisp:error
"Error macro-expanding ~S: ~@?" 'condition-bind format)))
(let ((handlers ()))
(dolist (clause condition-handler-bindings)
(unless (and (consp clause)
(consp (cdr clause))
;; could warn about condition-names which aren't known
;; about at compile time
(or ;; Should the empty list of conditions be legal?
;; Warned about?
(null (car clause))
(symbolp (car clause))
(and (listp (car clause))
(every #'symbolp (car clause))))
(null (cddr clause)))
(lose "~%The form \"~S\" does not appear to be a \"binding\"~% ~
-- ie a list of (<condition-names-to-handle> <handler-function>)."
clause))
;; Be careful to evaluate the handler at the right time!
;; [(condition-bind ((error *error-handler*))
;; (let ((*error-handler* #)) ...))
;; must handle errors using the outer binding of *error-handler*]
(push (list ;; test-function
`#'(lambda (.condition.)
(declare (type condition .condition.))
;; an implementation could use a more efficient form of
;; typep here, since we guarantee that .condition.
;; is always a condition
;;>> Why not have the user supply a type-specifier
;;>> rather than condition/list-of-conditions?
;;>> This would be more consistent with the rest of
;;>> the language (though might make such typep
;;>> optimizations less feasible.
(typep .condition. ,(if (listp (car clause))
`'(or . ,(car clause))
`',(car clause))))
;; separate (sigh) handler-function
(cadr clause)
;,@(cddr clause)
)
handlers))
`(stack-consing-frobs t (*established-condition-handlers*
,@(nreverse handlers))
. ,body))))
(defun signal (datum &rest args)
"\"Signals\" a condition.
The condition which is signalled is specified by DATUM and ARGS (see below.)
\"Signalling\" involves the following steps:
Firstly, all active condition-handlers (established by dynamically active
CONDITION-BINDs and CONDITION-CASEs) are called in most-recently-established-
first order. If any of these handle the condition (by doing transferring
control non-locally) the signalling process is terminated by that control
transfer.
Next, the default-handler for the condition is called, which may likewise
decide to handle the condition and thus terminate the signalling.
If the default handler for CONDITION declines, then the default-handlers
for each of the parent-types of CONDITION are called in order.
(Note that certain types of conditions, such as those based on ERROR,
cause the debugger to be entered as their default-handler.)
If the condition is neither handled by some dynamic handler, nor by its
default-handlers, then SIGNAL just returns the condition signalled.
The condition to be signalled is determined as follows:
If DATUM is a condition object, then that condition itself is used.
In this case, it is an error for ARGS to be non-NIL.
If DATUM is a condition-type name (defined by DEFINE-CONDITION),
then the condition used is the result of doing
(APPLY #'MAKE-CONDITION DATUM ARGS)
Any other type of DATUM is an error."
#+lmi (declare (dbg:error-reporter))
(let ((condition
(etypecase datum
(condition datum)
;; this is useless
; (string (make-condition 'simple-condition
; :format-string datum
; :format-arguments args))
(condition-name (apply #'make-condition datum
; god damned fucking unrequested stack consing
#+lispm (copy-list args)
#-lispm args)))))
;; search handlers
#-nil
(do ((handlers *established-condition-handlers* (cdr handlers)))
((null handlers))
(let ((*established-condition-handlers* (cdr handlers)))
(when (funcall (caar handlers) condition)
(apply (cadar handlers) condition #|(cddar handlers)|#))))
#+nil
(do ((handlers *established-condition-handlers* (svref handlers 2)))
((null handlers))
(let ((*established-condition-handlers* (svref handlers 2)))
(when (funcall (svref handlers 0) condition)
(funcall (svref handlers 1) condition))))
;; default handler
;; this is different from what KMP specified in eprop5
(let ((*established-condition-handlers* ())) ;;>> I don't know if this is right
#-lmnil
(let ((descriptor (%get-condition-descriptor condition)))
(dolist (d (condition-descriptor-descriptors descriptor))
(let ((h (condition-descriptor-default-handler d)))
(when h (funcall h condition)))))
#+lmnil
(si:send condition 'handle-condition-default) ;isn't method-combination wonderful?
)
;; no handlers.
condition))