Avoid locking up the thread pool channel on letpar& exceptions
Previously, if an exception occurred during the processing of any but the last letpar& expression, the replies for the other expressions would never be fetched, resulting in that thread in the pool just waiting for a receiver for the message. To avoid this, make sure to read all the replies before raising any exceptions.
This commit is contained in:
parent
a8d5ea4654
commit
888d9fcb98
1 changed files with 11 additions and 1 deletions
|
|
@ -111,6 +111,16 @@
|
||||||
(result
|
(result
|
||||||
(apply values result))))
|
(apply values result))))
|
||||||
|
|
||||||
|
(define (fetch-result-of-defered-thunks . reply-channels)
|
||||||
|
(let ((responses (map get-message reply-channels)))
|
||||||
|
(map
|
||||||
|
(match-lambda
|
||||||
|
(('worker-thread-error . exn)
|
||||||
|
(raise-exception exn))
|
||||||
|
(result
|
||||||
|
(apply values result)))
|
||||||
|
responses)))
|
||||||
|
|
||||||
(define-syntax parallel-via-thread-pool-channel
|
(define-syntax parallel-via-thread-pool-channel
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(syntax-case x ()
|
(syntax-case x ()
|
||||||
|
|
@ -120,7 +130,7 @@
|
||||||
(lambda ()
|
(lambda ()
|
||||||
e0)))
|
e0)))
|
||||||
...)
|
...)
|
||||||
(values (fetch-result-of-defered-thunk tmp0) ...)))))))
|
(apply values (fetch-result-of-defered-thunks tmp0 ...))))))))
|
||||||
|
|
||||||
(define-syntax-rule (letpar& ((v e) ...) b0 b1 ...)
|
(define-syntax-rule (letpar& ((v e) ...) b0 b1 ...)
|
||||||
(call-with-values
|
(call-with-values
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue