(import (vicare)
  (only (vicare checks)
        with-result
        add-result))

;;No handlers installed.  Signal a condition and
;;cause SIGNAL to return.
;;
(with-result
  (with-return-to-signal-on-unhandled-exception
    (add-result 'body-in)
    (signal (make-error))
    (add-result 'body-out)
    1))
⇒ (1 (body-in body-out))

;;No handlers installed.  Raise an exception with the
;;standard RAISE and show that it goes through the
;;"return to signal" syntax.
;;
(with-result
  (try
      (with-return-to-signal-on-unhandled-exception
        (add-result 'body-in)
        (raise (make-error))
        (add-result 'body-out)
        1)
    (catch E
      ((&error)
       (add-result 'catch-error)
       2))))
⇒ (2 (body-in catch-error))

;;No handlers installed.  Raise an exception with the
;;standard RAISE-CONTINUABLE and show that it goes
;;through the "return to signal" syntax.
;;
(with-result
  (try
      (with-return-to-signal-on-unhandled-exception
        (add-result 'body-in)
        (raise-continuable (make-error))
        (add-result 'body-out)
        1)
    (catch E
      ((&error)
       (add-result 'catch-error)
       2))))
⇒ (2 (body-in catch-error))

;;No handlers installed.  Raise an exception with the
;;standard RAISE-CONTINUABLE and show that it goes
;;through the "return to signal" syntax.
;;
(with-result
  (with-exception-handler
      (lambda (E)
        (add-result 'exception-handler))
    (lambda ()
      (with-return-to-signal-on-unhandled-exception
        (add-result 'body-in)
        (raise-continuable (make-error))
        (add-result 'body-out)
        1))))
⇒ (1 (body-in exception-handler body-out))

;;;

;;Nested RESTART-CASE and HANDLER-BIND.  Signal a condition,
;;call the first handler, the first handler declines, call
;;the second handler, the second handler declines, SIGNAL
;;returns.
;;
(with-result
  (with-return-to-signal-on-unhandled-exception
    (handler-bind
        ((&error (lambda (E)
                   (add-result 'outer-error-handler))))
      (handler-bind
          ((&error (lambda (E)
                     (add-result 'inner-error-handler))))
        (add-result 'body-in)
        (signal (make-error))
        (add-result 'body-out)
        1))))
⇒ (1
      (body-in
       inner-error-handler
       outer-error-handler
       body-out))

(import (vicare)
  (only (vicare checks)
        with-result
        add-result))

(with-result
  (restart-case
      (with-unwind-handler
          (lambda (why)
            (add-result 'unwind-handler))
        (lambda ()
          (add-result 'body-enter)
          (invoke-restart 'alpha)
          (add-result 'body-return)))
    (alpha (lambda ()
             (add-result 'restart-alpha)
             1))))
⇒ (1 (body-enter restart-alpha unwind-handler))

(internal-body

  (define (doit C)
    (with-result
      (returnable
        (handler-bind
            ((&error   (lambda (E)
                         (add-result 'error-handler)
                         (return 1))))
          (with-unwind-handler
              (lambda (why)
                (add-result 'outer-unwind-handler))
            (lambda ()
              (handler-bind
                  ((&warning (lambda (E)
                               (add-result 'warning-handler)
                               (return 2))))
                (with-unwind-handler
                    (lambda (why)
                      (add-result 'inner-unwind-handler))
                  (lambda ()
                    (add-result 'body-begin)
                    (signal C)
                    (add-result 'body-normal-return))))))))))

  (doit (make-error))
  ⇒ (1
        (body-begin
         error-handler
         inner-unwind-handler
         outer-unwind-handler))

  (doit (make-warning))
  ⇒ (2
        (body-begin
         warning-handler
         inner-unwind-handler
         outer-unwind-handler))

  #| end of body |# )