cbaines/guile-knots
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Allow passing custom channels to fiberize

Browse source 
This allows customising the behevaiour, for example by using a queue.
This commit is contained in:
Christopher Baines 2025-02-19 12:46:51 +00:00
parent ca3d5a1781
commit 99245034ea
1 changed files with 43 additions and 41 deletions
Download patch file Download diff file Expand all files Collapse all files

12
knots/parallelism.scm
View file

@ -238,15 +238,17 @@
#f))))
channels-to-results))))))))
(define* (fiberize proc #:key (parallelism 1))
(let ((channel (make-channel)))
(define* (fiberize proc
#:key (parallelism 1)
(input-channel (make-channel))
(process-channel input-channel))
(for-each
(lambda _
(spawn-fiber
(lambda ()
(while #t
(let ((reply-channel args (car+cdr
(get-message channel))))
(get-message process-channel))))
(put-message
reply-channel
(call-with-escape-continuation
@ -270,7 +272,7 @@
(lambda args
(let ((reply-channel (make-channel)))
(put-message channel (cons reply-channel args))
(put-message input-channel (cons reply-channel args))
(match (get-message reply-channel)
(('result . vals) (apply values vals))
(('exception exn stack)
@ -279,4 +281,4 @@
(raise-exception
(make-exception
knots-exn
exn)))))))))
exn))))))))