suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cs: avoid indirection through Chez Scheme for raise

Browse Source
This commit is contained in:
Matthew Flatt 2019-06-20 14:36:49 -06:00
parent 3f35504355
commit bf692f572d
1 changed files with 29 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
racket/src/cs/rumble/error.ss
View File

@ -6,8 +6,34 @@
(if barrier?
(call-with-continuation-barrier
(lambda ()
(chez:raise v)))
(chez:raise v))]))
(do-raise v)))
(do-raise v))]))
(define (do-raise v)
(let ([hs (continuation-mark-set->list (current-continuation-marks/no-trace)
exception-handler-key
the-root-continuation-prompt-tag)]
[init-v (condition->exn v)])
(let ([call-with-nested-handler
(lambda (thunk)
(call-with-exception-handler
(make-nested-exception-handler "exception handler" init-v)
(lambda ()
(call-with-break-disabled thunk))))])
(let loop ([hs hs] [v init-v])
(cond
[(null? hs)
(call-with-nested-handler
(lambda () (|#%app| (|#%app| uncaught-exception-handler) v)))
;; Use `nested-exception-handler` if the uncaught-exception
;; handler doesn't escape:
((make-nested-exception-handler #f v) #f)]
[else
(let ([h (car hs)]
[hs (cdr hs)])
(let ([new-v (call-with-nested-handler
(lambda () (|#%app| h v)))])
(loop hs new-v)))])))))
;; ----------------------------------------
@ -762,31 +788,7 @@
[(and (warning? v)
(not (non-continuable-violation? v)))
(log-system-message 'warning (exn->string exn))]
[else
(let ([hs (continuation-mark-set->list (current-continuation-marks/no-trace)
exception-handler-key
the-root-continuation-prompt-tag)]
[init-v (condition->exn v)])
(let ([call-with-nested-handler
(lambda (thunk)
(call-with-exception-handler
(make-nested-exception-handler "exception handler" init-v)
(lambda ()
(call-with-break-disabled thunk))))])
(let loop ([hs hs] [v init-v])
(cond
[(null? hs)
(call-with-nested-handler
(lambda () (|#%app| (|#%app| uncaught-exception-handler) v)))
;; Use `nested-exception-handler` if the uncaught-exception
;; handler doesn't escape:
((make-nested-exception-handler #f v) #f)]
[else
(let ([h (car hs)]
[hs (cdr hs)])
(let ([new-v (call-with-nested-handler
(lambda () (|#%app| h v)))])
(loop hs new-v)))]))))]))))
[else (do-raise v)]))))
(define (make-nested-exception-handler what old-exn)
(lambda (exn)