From f8ac6e3dd920d3dd7c05c1d57c92865f1e340313 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Thu, 31 Oct 2024 16:42:22 +0000 Subject: Add make-queueing-channel From the build coordinator. --- guix-data-service/utils.scm | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) (limited to 'guix-data-service') diff --git a/guix-data-service/utils.scm b/guix-data-service/utils.scm index 48f9c88..5f70f38 100644 --- a/guix-data-service/utils.scm +++ b/guix-data-service/utils.scm @@ -20,6 +20,7 @@ #:use-module (srfi srfi-9) #:use-module (srfi srfi-11) #:use-module (srfi srfi-71) + #:use-module (ice-9 q) #:use-module (ice-9 ftw) #:use-module (ice-9 match) #:use-module (ice-9 atomic) @@ -80,7 +81,9 @@ call-with-sigint run-server/patched - spawn-port-monitoring-fiber)) + spawn-port-monitoring-fiber + + make-queueing-channel)) (define (call-with-time-logging action thunk) (simple-format #t "debug: Starting ~A\n" action) @@ -1188,3 +1191,25 @@ If already in the worker thread, call PROC immediately." (sigaction SIGINT (car handler) (cdr handler)) ;; restore original C handler. (sigaction SIGINT #f)))))) + +(define (make-queueing-channel channel) + (define queue (make-q)) + + (let ((queue-channel (make-channel))) + (spawn-fiber + (lambda () + (while #t + (if (q-empty? queue) + (enq! queue + (perform-operation + (get-operation queue-channel))) + (let ((front (q-front queue))) + (perform-operation + (choice-operation + (wrap-operation (get-operation queue-channel) + (lambda (val) + (enq! queue val))) + (wrap-operation (put-operation channel front) + (lambda _ + (q-pop! queue)))))))))) + queue-channel)) -- cgit v1.2.3