anchor.diff:  (defmethod default-handler ((c serious-condition))
     (invoke-debugger c))
   (defmethod default-handler ((c restart))
  -  (signal (make control-error)))
  +  (error (make control-error)))
   
   (defclass handler ()
     (.handler-class
  -   .handler-function))
  -
  -(defun make-handler ((handler-class class) (handler-function function))
  +   .handler-function
  +   .associated-condition))
  +
  +(defun make-handler ((handler-class class) (handler-function function)
  +                     &optional associated-condition)
     (let ((h (make handler)))
       (setf (.handler-class h) handler-class)
       (setf (.handler-function h) handler-function)
  +    (setf (.associated-condition h) associated-condition)
       h))
  -
  -(defdynamic handler-frame)
   
   (defclass handler-frame ()
     (.handlers
      .parent-frame))
   
  -(defun make-handler-frame ((handlers list))
  +(defun make-handler-frame ((handlers list) &optional parent-frame)
     (let ((f (make handler-frame)))
       (setf (.handlers f) handlers)
  -    (setf (.parent-frame f) (dynamic handler-frame))
  +    (setf (.parent-frame f) parent-frame)
       f))
   
  -(defmacro handler-bind (handler-specs &rest body)
  -  "handler-spec ::= (class-name function-form)"
  -  #`(handler-bind/f (list ,@(compound-map
  -                             (lambda (handler-spec)
  -                               #`(make-handler
  -                                  (class ,(compound-elt handler-spec 0))
  -                                  ,(compound-elt handler-spec 1)))
  -                             handler-specs))
  -                    (lambda () ,@body)))
  -
  -(defun handler-bind/f ((handlers list) (body-function function))
  -  (dynamic-bind ((handler-frame (make-handler-frame handlers)))
  -    (funcall body-function)))
  -
  -(defun find-applicable-handler-and-frame ((c condition)
  -                                          &optional (f (dynamic handler-frame)))
  -  (unless (nil? f)
  -    (block found
  -      (each (lambda (h)
  -              (when (subtype? (type-of c) (.handler-class h))
  -                (return-from found (list h f))))
  -            (.handlers f))
  -      (find-applicable-handler-and-frame c (.parent-frame f)))))
  -
  -(defun signal ((c condition))
  -  (signal0 c (dynamic handler-frame)))
  -
  -(defun signal0 ((c condition) f)
  -  (let ((handler-and-frame (find-applicable-handler-and-frame c f)))
  +(defmacro define-handler-infrastructure (condition-bind signal condition dynamic-frame)
  +  #`(progn
  +      (defdynamic ,dynamic-frame)
  +      (defmacro ,condition-bind (condition-specs &rest body)
  +        "condition-spec ::= (class-name function-form associated-condition)"
  +        #`(condition-bind-1st-class
  +           (dynamic-id ,dynamic-frame)
  +           (list ,@(compound-map
  +                    (lambda (handler-spec)
  +                      #`(make-handler
  +                         (class ,(compound-elt handler-spec 0))
  +                         ,(compound-elt handler-spec 1)
  +                         ,(compound-elt handler-spec 2)))
  +                    handler-specs))
  +           (lambda () ,@body)))
  +      (defun ,signal ((c ,condition))
  +        (signal0 c (dynamic-id ,dynamic-frame) (dynamic ,dynamic-frame)))))
  +
  +(defun condition-bind-1st-class ((df dynamic) (handlers list) (f body-function))
  +  (dynamic-bind-1st-class df (make-handler-frame handlers)
  +    f))
  +
  +(defun signal0 ((c condition) (df dynamic) (f handler-frame))
  +  (let* ((handler-and-frame (find-applicable-handler-and-frame c f)))
       (if (nil? handler-and-frame)
           (default-handler c)
           (let ((h (elt handler-and-frame 0))
                 (f (elt handler-and-frame 1)))
  -          (funcall (.handler-function h) c)
  +          (signal-condition c h df f)
             ;; signal unhandled: continue search for handlers
             (signal0 c (.parent-frame f))))))
  +
  +(defun find-applicable-handler-and-frame ((c condition) (f handler-frame))
  +  (when f
  +    (block found
  +      (each (lambda (h)
  +              (when (condition-applicable? c h)
  +                (return-from found (list h f))))
  +            (.handlers f))
  +      (find-applicable-handler-and-frame c (.parent-frame f)))))
  +
  +(defgeneric condition-applicable? (condition handler))
  +
  +(defmethod condition-applicable? ((c condition) (h handler))
  +  (subtype? (type-of c) (.handler-class h)))
  +
  +(defmethod condition-applicable? ((r restart) (h handler))
  +  (and (subtype? (type-of c) (.handler-class h))
  +       (or (nil? (.associated-condition r))
  +           (nil? (.associated-condition h)))
  +           (= (.associated-condition r) (.associated-condition h))))
  +
  +(defgeneric signal-condition (condition handler dynamic-frame))
  +
  +(defmethod signal-condition ((c condition) (h handler) (df dynamic) (f frame))
  +  (dynamic-bind-1st-class df (.parent-frame f) ; condition firewall
  +    (lambda () (funcall (.handler-function h) c))))
  +
  +(defmethod signal-condition ((r restart) (h handler) (df dynamic) (f frame))
  +  ;; no restart firewall
  +  (funcall (.handler-function h) r))
  +
  +;; get meta
  +(define-handler-infrastructure handler-bind signal condition handler-frame)
  +(define-handler-infrastructure restart-bind invoke-restart restart restart-frame)
  +
  +(defparameter $error $signal)
  +(defparameter $warn $signal)
  +
  +;;;; Streams
  +
   
   ;;;; Collections
   
  
positive.code: (define-stupid-show restart)
  (define-stupid-show abort)
  
  (defgeneric default-handler (condition))
  (defmethod default-handler ((c condition))
    nil)
  (defmethod default-handler ((c warning))
  
negative.code: (defmacro dynamic-bind-1 (binding &rest body)
    (let ((name (compound-elt binding 0))
          (value (compound-elt binding 1)))
      #`(dynamic-bind-1st-class ,(dynamic name) ,value
          (lambda () ,@body))))
  
  (defun dynamic-bind-1st-class ((d dynamic) value (f function))
    (let ((old-value (.dynamic-value d)))
      (setf (.dynamic-value d) ,value)
      (unwind-protect (funcall f)
        (setf (.dynamic-value d old-value)))))
  
  ;;;; Conditions
  
  