exc.rkt

;;; http://www.cs.utah.edu/plt/delim-cont/

(require racket/control)

(define catch-prompt-tag (make-continuation-prompt-tag))

(define-syntax my-handle
  (syntax-rules ()
    [(_ expr handler)
     (with-continuation-mark 
      'exc handler
      expr)]))

(define-syntax my-catch 
  (syntax-rules ()
    [(_ expr handler)
     (call/prompt
      (lambda () 
        (my-handle expr (lambda (x) (abort/cc catch-prompt-tag
                                           x))))
      catch-prompt-tag
      handler)]))


(define-syntax default-exception-handler 
  (syntax-rules ()
    [(_ val)
     (if (null? (continuation-mark-set->list 
                 (current-continuation-marks)
                 'exc))
         (begin (printf "uncaught: ~a\n" val)
                (abort/cc (default-continuation-prompt-tag)
                          (lambda () (values))))
         val)]))

(define (my-raise val)
  (default-exception-handler
    (foldl (lambda (f x) (f x))
           val
           (continuation-mark-set->list (current-continuation-marks)
                                        'exc))))