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