;sequenceかどうか
(define (sequence? l)
　(and (pair? l)
　　　 (pair? (cdr l))))

;sequenceを置けるthrow (throw tag seq...)
(define-macro (throw tag . body)
　(list 'throw-value tag
　　(if (sequence? body)
　　　　(cons 'begin body)
　　　　(car body))))

(define (lisp-catch tag body)
　(call/cc (lambda (cont)
　　(set! *exception* (cons (cons 'catch (cons tag cont)) *exception*))
　　(throw-value tag (body)))))

(define-macro (catch tag . body)
　`(lisp-catch ,tag (lambda () ,@body)))

(define (call-with-catch tag test catch)
　(let ((throw? #t))
　　(let ((result
　　　(call/cc (lambda (cont)
　　　　(set! *exception* (cons (cons 'catch (cons tag cont)) *exception*))
　　　　(throw-value tag (prog1 (test) (set! throw? #f)))))))
　　　(if throw?
　　　　(catch result)
　　　　result))))

(define (unwind-protect test finally)
　(let ((current *exception*))
　　(push (cons 'finally finally) *exception*)
　　(let ((r (test)))
　　　(set! *exception* current)
　　　(finally)
　　　r)))