(define values)
(define call-with-values)
(let ((magic (cons 'multiple 'values)))
  (define magic?
    (lambda (x)
      (and (pair? x) (eq? (car x) magic))))

  (set! call-with-current-continuation
    (let ((primitive-call/cc
           call-with-current-continuation))
      (lambda (p)
        (primitive-call/cc
          (lambda (k)
            (p (lambda args
                 (k (apply values args)))))))))

  (set! values
    (lambda args
      (if (and (not (null? args)) (null? (cdr args)))
          (car args)
          (cons magic args))))

  (set! call-with-values
    (lambda (producer consumer)
      (let ((x (producer)))
        (if (magic? x)
            (apply consumer (cdr x))
            (consumer x))))))

; parameters

(define make-parameter
   (case-lambda
      ((init guard)
       (unless (procedure? guard)
         (error 'make-parameter "~s is not a procedure" guard))
       (let ((v (guard init)))
          (case-lambda
             (() v)
             ((u) (set! v (guard u))))))
      ((init)
       (make-parameter init (lambda (x) x)))))

(define-syntax parameterize
  ; simplified version limited to one parameter / value "binding"
  (syntax-rules ()
    ((_ ((x v)) e1 e2 ...)
     (let ((p x) (y v))
       (let ((swap (lambda () (let ((t (p))) (p y) (set! y t)))))
         (dynamic-wind swap (lambda () e1 e2 ...) swap))))))

(define current-exception-handler (make-parameter (lambda (exn) (abort))))

(define raise
  (lambda (exn)
    ((current-exception-handler) exn)))

(define-syntax with-handlers
  (syntax-rules ()
    ((_ ((predicate handler-procedure) ...) b1 b2 ...)
     ((call-with-current-continuation
        (lambda (k)
          (parameterize ((current-exception-handler
                          (let ((rh (current-exception-handler))
                                (preds (list predicate ...))
                                (handlers (list handler-procedure ...)))
                            (lambda (exn)
                              (parameterize ((current-exception-handler rh))
                                (let f ((preds preds) (handlers handlers))
                                  (if (not (null? preds))
                                      (if ((car preds) exn)
                                          (k (lambda () ((car handlers) exn)))
                                          (f (cdr preds) (cdr handlers))))))
                              (rh exn)))))
            (call-with-values
              (lambda () b1 b2 ...)
              (lambda args (k (lambda () (apply values args))))))))))))

;;;------------------------------------------------------------------

(define-syntax with-continuing-handlers
  (syntax-rules ()
    ((_ ((predicate handler-procedure) ...) b1 b2 ...)
     ((call-with-current-continuation
        (lambda (k)
          (parameterize
            ((current-exception-handler
               (let ((rh (current-exception-handler))
                     (preds (list predicate ...))
                     (handlers (list handler-procedure ...)))
                 (lambda (exn)
                   (call-with-current-continuation
                     (lambda (k1)
                       (parameterize ((current-exception-handler rh))
                         (let f ((preds preds) (handlers handlers))
                           (if (not (null? preds))
                               (if ((car preds) exn)
                                   (k (lambda ()
                                        (k1 ((car handlers) exn))))
                                   (f (cdr preds) (cdr handlers))))))
                       (rh exn)))))))
            (call-with-values
              (lambda () b1 b2 ...)
              (lambda args (k (lambda () (apply values args))))))))))))

(define-syntax with-rec-handlers
  (syntax-rules ()
    ((_ ((predicate handler-procedure) ...) b1 b2 ...)
     ((call-with-current-continuation
        (lambda (k)
          (letrec
            ((new-rh
               (let ((rh (current-exception-handler))
                     (preds (list predicate ...))
                     (handlers (list handler-procedure ...)))
                 (lambda (exn)
                   (parameterize ((current-exception-handler rh))
                     (let f ((preds preds) (handlers handlers))
                       (if (not (null? preds))
                           (if ((car preds) exn)
                               (k (lambda ()
                                    (parameterize ((current-exception-handler
                                                     new-rh))
                                      ((car handlers) exn))))
                               (f (cdr preds) (cdr handlers))))))
                   (rh exn)))))
            (parameterize ((current-exception-handler new-rh))
              (call-with-values
                (lambda () b1 b2 ...)
                (lambda args (k (lambda () (apply values args)))))))))))))

;;;------------------------- chez specific --------------------------

(define make-exception list)

(define exn:div (make-exception "exn: div"))
(define exn:car (make-exception "exn: car"))
(define exn:cdr (make-exception "exn: cdr"))
(define exn:append (make-exception "exn: append"))
(define exn:unbound-variable (make-exception "exn: unbound variable"))
(define exn:map-1st-arg (make-exception "exn: map 1st arg"))
(define exn:map-2nd-arg (make-exception "exn: map 2nd arg"))
(define exn:wrong-number-of-args (make-exception "exn: wrong number of args"))
(define exn:open-input-file (make-exception "exn: open-input-file"))

(error-handler
  (let ((old-error-handler (error-handler))
        (table (list
                 (cons (cons '/ "undefined for ~s") exn:div)
                 (cons (cons 'car "~s is not a pair") exn:car)
                 (cons (cons 'cdr "~s is not a pair") exn:cdr)
                 (cons (cons 'append "~s is not a proper list") exn:append)
                 (cons (cons 'map "~s is not a procedure") exn:map-1st-arg)
                 (cons (cons 'map "~s is not a proper list") exn:map-2nd-arg)
                 (cons
                   (cons #f "variable ~s is not bound") exn:unbound-variable)
                 (cons
                   (cons #f "incorrect number of arguments to ~s")
                   exn:wrong-number-of-args)
                 (cons (cons 'open-input-file "error opening ~s: ~a")
                   exn:open-input-file)))
        (pair? pair?)
        (assoc assoc)
        (cons cons)
        (car car)
        (cdr cdr)
        (apply apply)
        (write write)
        (newline newline)
        (raise* raise))
    (lambda args
      (write args)
      (newline)
      (let ((pair (assoc (cons (car args) (car (cdr args))) table)))
        (if (pair? pair)
            (raise* (cons (cdr pair) (cdr (cdr args))))
            (begin (write args) (newline) (apply old-error-handler args)))))))

(let ((default-handler
  ; uses Chez Scheme reset procedure
       (lambda (exn)
         (newline)
         (display "Uncaught Exception: ")
         (write exn)
         (if (pair? (cdr exn))
             (begin
               (display " with ")
               (for-each (lambda (x) (display " ") (write x)) (cdr exn))))
         (newline)
         (reset))))
  (current-exception-handler default-handler))

(define OutOfRange "Out Of Range")

(define comb1
  (lambda (n m)
    (cond
      ((negative? n) (raise (list OutOfRange n m)))
      ((or (negative? m) (> m n)) (raise (list OutOfRange n m)))
      ((or (zero? m) (= m n)) 1)
      (else (+ (comb1 (sub1 n) m) (comb1 (sub1 n) (sub1 m)))))))

(define comb
  (lambda (n m)
    (with-handlers
      (((lambda (exn)
          (let ((name (car exn)))
            (eq? name OutOfRange)))
        (lambda (exn)
          (let ((n (cadr exn)) (m (caddr exn)))
            (cond
              ((and (= n 0) (= m 0)) 1)
              (else (begin
                      (display "out of range: n=")
                      (write n)
                      (display " m=")
                      (write m)
                      (newline)
                      0)))))))
      (comb1 n m))))

(define test0
  (lambda ()
    (display "test: (comb 4 2) = ")
    (newline)
    (write (comb 4 2))
    (newline)
    (display "test: (comb 3 4): = ")
    (newline)
    (write (comb 3 4))
    (newline)
    (display "test: (comb 0 0): = ")
    (write (comb 0 0))
    (newline)))

(define test1  ;;; Uncaught Exception exn:div
  (lambda ()
    (/ 2 0)))

(define f1
  (lambda (n)
    (if (= n 4)
      0
      1)))

(define test2  ;;; Uncaught Exception exn:div
  (lambda ()
    (/ 3 (f1 4))))

(define test3  ;;; 3
  (lambda ()
    (/ 3 (f1 5))))

(define test4  ;;; 5
  (lambda ()
    (/ 5 (f1 8))))

(define test5  ;;; 3.5
  (lambda ()
    (with-handlers (((lambda (x) #t) (lambda (exn) 3.5)))
      (/ -2.3 0))))

(define c-eq?
  (lambda (name)
    (lambda (exn)
      (eq? name (car exn)))))

(define test6  ;;;  Uncaught Exception exn:div
  (lambda ()
    (with-handlers
      (((c-eq? exn:car) (lambda (exn) 99999999999999)))
      (/ 7 (- 2 2)))))

(define test7  ;;; 3
  (lambda ()
    (with-handlers
      (((c-eq? exn:car) (lambda (exn) 1))
       ((c-eq? exn:cdr) (lambda (exn) 2))
       ((c-eq? exn:div) (lambda (exn) 3))
       ((lambda (x) #t) (lambda (exn) 4)))
      (/ 1 0))))

(define test8  ;;; Uncaught Exception exn:div
  (lambda ()
    (raise exn:div)))

(define test9  ;;; 4
  (lambda ()
    (if (= 1 2) (raise exn_car) 4)))

(define test10  ;;; Uncaught Exception  exn:car
  (lambda ()
    (if (= 1 1) (raise exn:car) 4)))

(define exn:nonpos (make-exception "exn: nonpos"))

(define f2
  (lambda (n)
    (if (> n 0)
      (sub1 n)
      (raise (list exn:nonpos)))))

(define test11 ;;; 3
  (lambda ()
    (f2 4)))

(define test12 ;;; Uncaught Exception exn:nonpos
  (lambda ()
    (f2 -4)))

(define test13 ;;; 0
  (lambda ()
    (with-handlers
      (((c-eq? exn:nonpos) (lambda (exn) 0)))
      (f2 -4))))

(define g2
  (lambda (n)
    (with-handlers
      (((c-eq? exn:nonpos) (lambda (exn) 0)))
      (f2 n))))

(define test14 ;;; 3
  (lambda ()
    (g2 4)))

(define test15 ;;; 0
  (lambda ()
    (g2 -4)))

(define h3)

(let ((exn:1 (make-exception "exn: 1")))
  (set! h3
    (lambda (n)
      (if (> n 0)
        (sub1 n)
        (raise (list exn:1))))))

(define test16 ;;; 0
  (lambda ()
    (with-handlers (((lambda (x) #t)  (lambda (exn) 0)))
      (h3 -4))))

(define test17 ;;; exn:1 is unbound
  (lambda ()
    (raise (list exn:1))))

(define test18 ;;; exn:1 is unbound
  (lambda ()
    (with-handlers (((lambda (exn) (eq? (car exn) exn:1)) (lambda (exn) 0)))
      (h3 -4))))

(define test19 ;;; 0
  (lambda ()
    (with-handlers (((c-eq? exn:nonpos) (lambda (exn) -1)))
       (g2 -4))))

(define test20 ;;; by the time g is called, exn:nonpos is gone ;;;; 0
  (lambda ()
    (g2 (with-handlers
          (((c-eq? exn:nonpos) (lambda (exn) -2)))
          -4))))

(define h4
  (lambda (x)
    (with-handlers (((c-eq? exn:div) (lambda (exn) 3)))
      x)))

(define test21 ;;; Uncaught Exception exn:div
  (lambda ()
    (h4 (raise (list exn:div)))))

(define f5
  (lambda (n)
    (let ((exn:toobig (make-exception "exn: toobig")))
      (if (> n 100)
        (raise (list exn:toobig))
        (add1 n)))))

(define test22 ;;; 51
  (lambda ()
    (f5 50)))

(define test23 ;;; Uncaught Exception exn:toobig
  (lambda ()
    (f5 101)))

(define exn:toobig (make-exception "exn: toobig"))

(define test24 ;;; Uncaught Exception exn:toobig
  (lambda ()
    (with-handlers
      (((c-eq? exn:toobig) (lambda (exn) 5)))
      (f5 101))))

(define f6
  (let ((exn:toobig (make-exception "exn: toobig")))
    (lambda (n)              
      (if (> n 100)
        (raise (list exn:toobig))
        (add1 n)))))

(define test25 ;;; 2
  (lambda ()
    (with-handlers
      (((c-eq? exn:toobig) (lambda (exn) 1))
       ((lambda (x) #t) (lambda (exn) 2)))
      (f6 101))))

(define exn:left-to-right (make-exception "exn: left-to-right"))

(define exn:right-to-left (make-exception "exn: right-to-left"))

(define test26  ;;; Uncaught Exception exn:left-to-right
                ;;; if the order of argument evaluation is left to right
  (lambda ()
    (list (raise exn:left-to-right) (raise exn:right-to-left))))

(define test27 ;;; 2
  (lambda ()
    (let ((exn:1 (make-exception "exn: 1")))
      (let ((f (lambda ()
                 (let ((exn:2 exn:1))
                   (raise (list exn:2))))))
        (with-handlers
          (((c-eq? exn:1) (lambda (exn) 1))
           ((lambda (x) #t) (lambda (exn) 2)))
          (f6 101))))))

(define test28  ;;; 1
  (lambda ()
    (let ((exn:1 (make-exception "exn: 1")))
      (let ((f (lambda ()
                 (let ((exn:1 exn:1))
                   (raise (list exn:1))))))
        (with-handlers
          (((c-eq? exn:1) (lambda (exn) 1))
           ((lambda (x) #t) (lambda (exn) 2)))
          (f))))))

(define half
  (lambda (n)
    (/ n 2)))

(define square
  (lambda (n)
    (* n n)))

(define strange?
  (lambda (n)
    (zero? (mod n 3))))

(define f7
  (lambda (n)
    (let ((exn:1 (make-exception "exn: 1")))
      (cond
        ((even? n) (with-handlers
                     (((c-eq? exn:1) (lambda (exn) n)));; worthless
                     (f7 (half n))))
        ((strange? n) (/ n 3))
        (else (raise (list exn:1)))))))

(define test29 ;;; 1
  (lambda ()
    (f7 3)))


(define test30 ;;; 1
  (lambda ()
    (f7 6)))

(define test31 ;;; Uncaught Exception exn:1
  (lambda ()
    (f7 5)))

(define test32 ;;; Uncaught Exception exn:1
  (lambda ()
    (f7 14)))


(define f8
  (let ((exn:1 (make-exception "exn: 1")))
    (lambda (n)
      (cond
        ((even? n) (with-handlers
                     (((c-eq? exn:1) (lambda (exn) n)))
                     (f8 (half n))))
        ((strange? n) (/ n 3))
        (else (raise (list exn:1)))))))

(define test33 ;;; 1
  (lambda ()
    (f8 3)))

(define test34 ;;; 1
  (lambda ()
    (f8 6)))

(define test35 ;;; Uncaught Exception exn:1
  (lambda ()
    (f8 5)))

(define test36 ;;; 14
  (lambda ()
    (f8 14)))

(define exn:5 (make-exception "exn: 1"))

(define f9
  (lambda (n)
    (cond
      ((positive? n) (sub1 n))
      (else (raise (list exn:5 n))))))

(define test37 ;;; Uncaught Exception exn:5 with -3
  (lambda ()
    (f9 -3)))

(define exn:prime (make-exception "exn: prime"))

(define exn:toobig (make-exception "exn: toobig"))

(define least-prime-factor
  (let ((primes (list 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61)))
    (let ((max (car (reverse primes))))
      (letrec
        ((f (lambda (n ls)
              (let ((h (car ls))
                    (t (cdr ls)))
                (cond
                  ((< n (square h)) (raise (list exn:prime n)))
                  ((<= (mod n h) 0) h)
                  (else (f n t)))))))
        (lambda (n)
          (if (< n max)
            (f n primes)
            (raise (list exn:toobig n max))))))))

(define test38 ;;; uncaught exception exn: tobig with 77 61
  (lambda ()
    (least-prime-factor 77)))

(define test39 ;;; 2
  (lambda ()
    (least-prime-factor 48)))

(define test40 ;;; uncaught exception exn: prime with 37
  (lambda ()
    (least-prime-factor 37)))

(define test41 ;;; 2
  (lambda ()
    (least-prime-factor 46)))

(define exn:5 (make-exception "exn: 5"))

(define f10
  (lambda (n)
    (if (even? n)
      (half n)
      (begin (write "Got here") (raise (list exn:5 n))))))

(define g10
  (lambda (n)
    (with-handlers
      (((c-eq? exn:5)
        (lambda (exn)
          (case (cadr exn)
            ((0) 0)
            ((1) 1)
            (else (if (strange? (cadr exn))
                      (/ (cadr exn) 3)
                      99))))))
      (f10 n))))

(define test42 ;;; 1
  (lambda ()
    (g10 2)))

(define test43 ;;; "Got here"99
  (lambda ()
    (g10 5)))

(define test44 ;;; "Got here"3
  (lambda ()
    (g10 9)))

(define exn:5 (make-exception "exn: 1"))

(define f11
  (lambda (n)
    (write n)
    (newline)
    (if (even? n)
      (half n)
      (begin (write "Got here") (newline) (raise (list exn:5 n))))))

(define g11 ;;; re-raise exn:5  
  (lambda (n)
    (with-handlers   ;;;;;; Wall
      (((c-eq? exn:5) (lambda (exn)
                        (case (cadr exn)
                          ((0) 0)
                          ((1) 1)
                          (else (if (strange? (cadr exn))
                                    (/ (cadr exn) 3)
                                    (begin
                                      (write "And here")
                                      (newline)
                                      (raise (list exn:5 (cadr exn))))))))))
      (f11 n))))

(define test45 ;;; "Got here"<n>"And here"<nn>Uncaught exception exn:5 with 13
  (lambda ()
    (write "Entering")
    (newline)
    (g11 13)))

(define g12
  (lambda (n)
    (with-handlers
      (((c-eq? exn:5)
        (lambda (exn)
          (case (cadr exn)
            ((0) 0)
            ((1) 1)
            (else (if (strange? (cadr exn))
                      (/ (cadr exn) 3)
                      99)))))
       ((c-eq? exn:div) (lambda u 98)))
      (f11 n))))

(define test46 ;;; 13<n>"Got here"<n>99
  (lambda ()
    (g12 13)))

(define f12 ;;; exceptions are first-class
  (lambda (x)
    (raise (list x))))

(define test47 ;;; uncaught exception: "exn: div"
  (lambda ()
    (f12 exn:div)))

(define exn:x (make-exception "exn: x"))

(define g13
  (lambda (x)
    (with-handlers
      (((c-eq? exn:x) (lambda (exn) 2)))
      1)))

(define test48 ;;; 1
  (lambda ()
    (g13 32)))

(define f13
  (lambda (x)
    (let ((exn:negative (make-exception "exn: negative"))
          (exn:positive (make-exception "exn: positive")))
      (cond
        ((< x 0) (write "To here") (newline) (raise (list  exn:x exn:negative)))
        ((> x 0) (raise (list exn:x exn:positive)))
        (else 0)))))

(define g14
  (lambda (x)
    (with-handlers
      (((c-eq? exn:x) (lambda (exn) (raise (list (cadr exn))))))
      (f13 x))))
      
(define test49  ;;; "To Here" Uncaught Exception exn:negative
  (lambda ()
    (g14 -5)))

(define test50 ;;; Uncaught Exception exn:positive
  (lambda ()
    (g14 5)))

(define test51 ;;; 0
  (lambda ()
    (g14 0)))

(define restart
  (lambda (exn rhe v)
    (let ((tmp (current-exception-handler)))
      (dynamic-wind
        (lambda () (current-exception-handler rhe))
        (lambda () (raise (list exn v)))
        (lambda () (current-exception-handler tmp))))))

(define test52 ;;; 999
  (lambda ()
    (let ((exn:5 (make-exception "exn: 1"))
          (restart:go-back (make-exception "restart: go-back")))
      (with-handlers (((c-eq? exn:5)
                       (lambda (exn)
                         (restart restart:go-back (cadr exn) 999))))
        (with-handlers
          (((c-eq? restart:go-back)
            (lambda (exn) (cadr exn))))
          (raise (list exn:5 (current-exception-handler))))))))

(define test53 ;;; 999
  (lambda ()
    (let ((exn:5 (make-exception "exn: 1"))
	  (restart:go-back (make-exception "restart: go-back")))
      (with-handlers (((c-eq? exn:5)
		       (lambda (exn)
                         (restart restart:go-back (cadr exn) 999))))
	(with-handlers
	  (((c-eq? restart:go-back) (lambda (exn) (cadr exn))))
	  (raise (list exn:1 (current-exception-handler))))))))

(define test54 ;;; 999
  (lambda ()
    (let ((exn:5 (make-exception "exn: 1"))
	  (restart:go-back (make-exception "restart go-back")))
      (with-handlers
	(((c-eq? restart:go-back) (lambda (exn) (cadr exn))))
	(with-handlers
	  (((c-eq? exn:5)
	    (lambda (exn)
              (restart restart:go-back (cadr exn) 999))))
	  (raise (list exn:5 (current-exception-handler))))))))

(define test55 ;;; foo
  (lambda ()
    (let ((exn:1 (make-exception "exn: 1"))
          (exn:2 (make-exception "exn: 2")))
      (with-rec-handlers
        (((c-eq? exn:1) (lambda (exn) (raise (list exn:2 'foo))))
         ((c-eq? exn:2) (lambda (exn) (cadr exn))))
        (with-handlers
          (((c-eq? exn:2) (lambda (exn) 'goo)))
          (raise (list exn:1)))))))

(define test56 ;;; 4<n>3<n>2<n>1<n>0<n>24
  (lambda ()
    (let ((exn:1 (make-exception "exn: 1"))
	  (restart:back (make-exception "restart: back")))
      (with-rec-handlers
	(((c-eq? exn:1)
	  (lambda (exn)
  	    (let ((exn-tag (car exn))
		  (x (cadr exn))
		  (raiser (caddr exn)))
	      (write x)
	      (newline)
	      (if (zero? x)
		  (restart restart:back raiser 1)
		  (restart restart:back raiser
		    (* x
		       (with-handlers
			 (((c-eq? restart:back) (lambda (exn) (cadr exn))))
			 (raise (list exn-tag (- x 1) (current-exception-handler)))))))))))
	(with-handlers
	  (((c-eq? restart:back) (lambda (exn) (cadr exn))))
	  (raise (list exn:1 4 (current-exception-handler))))))))

(define test57 ;;; 4<n>3<n>2<n>1<n>0<n>24
  (lambda ()
    (let ((exn:1 (make-exception "exn: 1"))
	  (restart:back (make-exception "restart: back")))
      (with-rec-handlers
	(((c-eq? exn:1)
	  (lambda (exn)
  	    (let ((exn-tag (car exn))
		  (x (cadr exn))
		  (raiser (caddr exn)))
	      (write x)
	      (newline)
	      (if (zero? x)
		  (restart restart:back raiser 1)
		  (restart restart:back raiser
		    (* x
		       (with-handlers
			 (((c-eq? restart:back) (lambda (exn) (cadr exn))))
			 (raise (list exn-tag (- x 1) (current-exception-handler)))))))))))
	(with-handlers
	  (((c-eq? restart:back) (lambda (exn) (cadr exn))))
	  (raise (list exn:1 4 (current-exception-handler))))))))

(define test58 ;;; 1<n>Uncaught Exception: "exn: div" with  0
  (lambda ()
    (with-handlers
      (((c-eq? exn:div) (lambda (exn)
		  (write 1)
		  (newline)
		  (raise (list (car exn) (cadr exn))))))
      (/ 2 0))))

(define test59 ;;; 1<n>2<n>Uncaught Exception: "exn: div" with  0
  (lambda ()
    (with-handlers
      (((c-eq? exn:div)
	(lambda (exn)
	  (write 2)
	  (raise (list (car exn) (cadr exn))))))
      (with-handlers
	(((c-eq? exn:div)
	  (lambda (exn)
	    (write 1)
	    (newline)
	    (raise (list (car exn) (cadr exn))))))
	(/ 2 0)))))

(define test60 ;;; "entered exception"<>exited exception with 8
  (let ((exn:continuing (make-exception "exn: continuing")))
    (lambda ()
      (with-continuing-handlers
	(((c-eq? exn:continuing)
	  (lambda (exn)
	    (write "entered exception") (newline) 8)))
	(let ((v (raise (list exn:continuing))))
	  (display "exited exception with ")
	  (write v)
	  (newline))))))

(define test61 ;;; Bad divide: Returning Big Number: 1000000000000000000000
  (let ((restart:div (make-exception "restart: div")))
    (lambda ()
      (+ 1
	 (with-handlers
	   (((c-eq? restart:div) (lambda (exn) (cadr exn))))
	   (with-handlers
	     (((c-eq? exn:div)
	       (lambda (exn)
		 (display "Bad divide: ")
		 (display "Returning Big Number: ")
		 (restart restart:div (current-exception-handler)
		   999999999999999999999))))
	     (+ 5 (/ 534678 (* 52 0)))))))))

(define test62 ;;; This is troublesome:
               ;;; Bad divide: Returning Big Number: 1000000000000000000000
  (let ((restart:div (make-exception "restart: div")))
    (lambda ()
      (+ 1
	 (with-handlers
	   (((c-eq? exn:div)
	     (lambda (exn)
	       (display "Bad divide: ")
	       (display "Returning Big Number: ")
	       (restart restart:div (cadr exn) 999999999999999999999))))
	   (with-handlers
	     (((c-eq? restart:div) (lambda (exn) (cadr exn))))
	     (with-handlers
	       (((c-eq? exn:div)
		 (lambda (exn)
	           (display "This is troublesome:")
	           (newline)
		   (raise (list (car exn) (current-exception-handler))))))
	       (+ 5 (/ 534678 (* 52 0))))))))))

(define test63 ;;; This is troublesome:
               ;;; Bad divide: Returning Big Number: 1000000000000000000000
  (let ((restart:div (make-exception "restart: div")))
    (lambda ()
      (+ 1
	 (with-handlers
	   (((c-eq? restart:div) (lambda (exn) (cadr exn))))
	   (with-handlers
	     (((c-eq? exn:div)
	       (lambda (exn)
		 (display "Bad divide: ")
		 (display "Returning Big Number: ")
		 (restart restart:div (current-exception-handler) 999999999999999999999))))
	     (with-handlers
	       (((c-eq? exn:div)
		 (lambda (exn)
		   (display "This is troublesome:")
		   (newline)
		   (restart (car exn) (current-exception-handler) (cadr exn)))))
	       (+ 5 (/ 534678 (* 52 0))))))))))

(define test64 ;;; ()<n>()<n>(8 8)
  (lambda ()
    (with-continuing-handlers
      (((c-eq? exn:div) (lambda (exn) (write (cdr exn)) (newline) 8)))
      (write (list (raise (list exn:div)) (raise (list exn:div))))
      (newline))))

(define exn:try-a-different-file (make-exception "exn: try a different file"))

(define open
  (let ((restart:looking-for-the-right-file
	  (make-exception "restart: looking for the right file")))
    (lambda (the-file-name)
      (with-handlers
	(((c-eq? restart:looking-for-the-right-file)
	  (lambda (exn) (cadr exn))))
	(with-handlers
	  (((c-eq? exn:try-a-different-file)
	     (lambda (exn)
	       (display "Read a different file instead of ")
	       (write the-file-name)
	       (restart
		 restart:looking-for-the-right-file
		 (current-exception-handler)
		 (open (read))))))
	  (guts-of-open the-file-name))))))
	   
(define open-file-print-handler
  (lambda (exn)
    (let ((verbose (cadr exn)))
      (if verbose
	  (raise exn)
          (begin
	    (display "The file ")
	    (write (caddr exn))
	    (display " was not found.")
	    (newline))))))

(define extend-current-exception-handler
  (lambda (rh new-exn-tag new-handler)
    (lambda (exn)
      (if ((c-eq? new-exn-tag) exn)
	  (new-handler exn)
	  (rh exn)))))
    
(current-exception-handler
  (extend-current-exception-handler (current-exception-handler)
    exn:open-input-file open-file-print-handler))

(define guts-of-open
  (lambda (the-file-name)
    (let ((result (operating-system-open the-file-name)))
      (cond
	((input-port? result) result)
	((string=? result "+file-not-found-error-code")
	 (display "This is what we expected.")
	 (newline)
	 (raise (list exn:open-input-file #f the-file-name)))
	(else "who kars")))))

(define operating-system-open
  (let ((restart:file-not-found (make-exception "restart: file not found")))
    (lambda (the-file-name)
      (with-handlers
	(((c-eq? restart:file-not-found) (lambda (exn) (cadr exn))))
	(with-handlers
	  (((c-eq? exn:open-input-file)
	     (lambda (exn)
	       (restart
		 restart:file-not-found
		 (current-exception-handler)
		 "+file-not-found-error-code"))))
	  (open-input-file the-file-name))))))

(define test65 ;;; This is what we expected.
               ;;; The file "this-file-does-not-exist" was not found.
  (lambda ()
    (guts-of-open "this-file-does-not-exist")))

(define number-of-tests 65)

(define tester
  (lambda ()
    (letrec
      ((loop (lambda (i)
               (if (> i number-of-tests)
                 'done
                 (begin
                   (display "--------------------------- Test")
                   (display i)
                   (newline)
                   (call/cc
                     (lambda (k)
                       (fluid-let ((reset (lambda () (k '*))))
                         (let ((ans
                           (eval 
                             (list
                               (string->symbol (string-append "test"
                                                 (number->string
                                                   i)))))))
                           (if (not (eq? (void) ans)) (write ans))))))
                   (newline)
                   (display "--------------------------- End")
                   (newline)
                   (loop (add1 i)))))))
      (loop 0))))

(tester)