Which is like spawn-fiber, but uses knots exception handling.
This commit is contained in:
parent
991a5f6961
commit
39ae5177f2
1 changed files with 32 additions and 1 deletions
33
knots.scm
33
knots.scm
|
|
@ -2,6 +2,7 @@
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (ice-9 suspendable-ports)
|
#:use-module (ice-9 suspendable-ports)
|
||||||
|
#:use-module (fibers)
|
||||||
#:use-module (fibers conditions)
|
#:use-module (fibers conditions)
|
||||||
#:use-module (system repl debug)
|
#:use-module (system repl debug)
|
||||||
#:export (call-with-default-io-waiters
|
#:export (call-with-default-io-waiters
|
||||||
|
|
@ -15,7 +16,9 @@
|
||||||
knots-exception?
|
knots-exception?
|
||||||
knots-exception-stack
|
knots-exception-stack
|
||||||
|
|
||||||
print-backtrace-and-exception/knots))
|
print-backtrace-and-exception/knots
|
||||||
|
|
||||||
|
spawn-fiber/knots))
|
||||||
|
|
||||||
(define (call-with-default-io-waiters thunk)
|
(define (call-with-default-io-waiters thunk)
|
||||||
(parameterize
|
(parameterize
|
||||||
|
|
@ -149,3 +152,31 @@
|
||||||
(close-output-port string-port)
|
(close-output-port string-port)
|
||||||
str)))))
|
str)))))
|
||||||
(display error-string port)))
|
(display error-string port)))
|
||||||
|
|
||||||
|
(define* (spawn-fiber/knots thunk #:optional scheduler #:key parallel?)
|
||||||
|
(spawn-fiber
|
||||||
|
(lambda ()
|
||||||
|
(with-exception-handler
|
||||||
|
(lambda (exn)
|
||||||
|
(display "Uncaught exception in task:\n"
|
||||||
|
(current-error-port))
|
||||||
|
(print-backtrace-and-exception/knots exn))
|
||||||
|
(lambda ()
|
||||||
|
(with-exception-handler
|
||||||
|
(lambda (exn)
|
||||||
|
(let ((stack
|
||||||
|
(match (fluid-ref %stacks)
|
||||||
|
((stack-tag . prompt-tag)
|
||||||
|
(make-stack #t
|
||||||
|
0 prompt-tag
|
||||||
|
0 (and prompt-tag 1)))
|
||||||
|
(_
|
||||||
|
(make-stack #t)))))
|
||||||
|
(raise-exception
|
||||||
|
(make-exception
|
||||||
|
exn
|
||||||
|
(make-knots-exception stack)))))
|
||||||
|
thunk))
|
||||||
|
#:unwind? #t))
|
||||||
|
scheduler
|
||||||
|
#:parallel? parallel?))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue