svn: r4842
This commit is contained in:
Matthew Flatt 2006-11-13 21:52:39 +00:00
parent 1de6b29aed
commit c6efe4bbfa
4 changed files with 1141 additions and 1120 deletions

File diff suppressed because it is too large Load Diff

View File

@ -9,6 +9,6 @@
#define MZSCHEME_VERSION_MAJOR 359 #define MZSCHEME_VERSION_MAJOR 359
#define MZSCHEME_VERSION_MINOR 100 #define MZSCHEME_VERSION_MINOR 200
#define MZSCHEME_VERSION "359.100" _MZ_SPECIAL_TAG #define MZSCHEME_VERSION "359.200" _MZ_SPECIAL_TAG

View File

@ -2723,8 +2723,11 @@
"((cdar l) e))))" "((cdar l) e))))"
"(else" "(else"
"(select-handler/breaks-as-is e bpz(cdr l)))))" "(select-handler/breaks-as-is e bpz(cdr l)))))"
"(define handler-prompt-key(make-continuation-prompt-tag))"
"(define false-thread-cell(make-thread-cell #f))" "(define false-thread-cell(make-thread-cell #f))"
"(define(check-with-handlers-in-context handler-prompt-key)"
"(unless(continuation-prompt-available? handler-prompt-key) "
"(error 'with-handlers"
" \"exception handler used out of context\")))"
"(define-syntaxes(with-handlers with-handlers*)" "(define-syntaxes(with-handlers with-handlers*)"
"(let((wh " "(let((wh "
"(lambda(disable-break?)" "(lambda(disable-break?)"
@ -2738,7 +2741,8 @@
"(syntax->list #'(handler ...))))))" "(syntax->list #'(handler ...))))))"
"(quasisyntax/loc stx" "(quasisyntax/loc stx"
"(let((pred-name pred) ..." "(let((pred-name pred) ..."
"(handler-name handler) ...)" "(handler-name handler) ..."
"(handler-prompt-key(make-continuation-prompt-tag)))"
"(let((bpz(continuation-mark-set-first #f break-enabled-key)))" "(let((bpz(continuation-mark-set-first #f break-enabled-key)))"
"(with-continuation-mark" "(with-continuation-mark"
" break-enabled-key" " break-enabled-key"
@ -2750,6 +2754,7 @@
" bpz" " bpz"
"(parameterize((current-exception-handler" "(parameterize((current-exception-handler"
"(lambda(e)" "(lambda(e)"
"(check-with-handlers-in-context handler-prompt-key)"
"(abort-current-continuation" "(abort-current-continuation"
" handler-prompt-key" " handler-prompt-key"
"(lambda()" "(lambda()"

View File

@ -3132,9 +3132,14 @@
[else [else
(select-handler/breaks-as-is e bpz (cdr l))])) (select-handler/breaks-as-is e bpz (cdr l))]))
(define handler-prompt-key (make-continuation-prompt-tag))
(define false-thread-cell (make-thread-cell #f)) (define false-thread-cell (make-thread-cell #f))
(define (check-with-handlers-in-context handler-prompt-key)
(unless (continuation-prompt-available? handler-prompt-key)
(error 'with-handlers
"exception handler used out of context")))
(define-syntaxes (with-handlers with-handlers*) (define-syntaxes (with-handlers with-handlers*)
(let ([wh (let ([wh
(lambda (disable-break?) (lambda (disable-break?)
@ -3148,7 +3153,8 @@
(syntax->list #'(handler ...))))]) (syntax->list #'(handler ...))))])
(quasisyntax/loc stx (quasisyntax/loc stx
(let ([pred-name pred] ... (let ([pred-name pred] ...
[handler-name handler] ...) [handler-name handler] ...
[handler-prompt-key (make-continuation-prompt-tag)])
;; Capture current break parameterization, so we can use it to ;; Capture current break parameterization, so we can use it to
;; evaluate the body ;; evaluate the body
(let ([bpz (continuation-mark-set-first #f break-enabled-key)]) (let ([bpz (continuation-mark-set-first #f break-enabled-key)])
@ -3170,6 +3176,7 @@
bpz bpz
(parameterize ([current-exception-handler (parameterize ([current-exception-handler
(lambda (e) (lambda (e)
(check-with-handlers-in-context handler-prompt-key)
;; Deliver a thunk to the escape handler: ;; Deliver a thunk to the escape handler:
(abort-current-continuation (abort-current-continuation
handler-prompt-key handler-prompt-key