From c886685e9284da4bbed9377f70dd70da9e7ca29f Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Tue, 14 Jan 2025 13:49:28 +0000 Subject: [PATCH] Update Guile Knots --- .../jobs/load-new-guix-revision.scm | 16 ++++---- guix-data-service/utils.scm | 37 ------------------- guix-dev.scm | 4 +- 3 files changed, 9 insertions(+), 48 deletions(-) diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index 4e2092f..c04d175 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -42,9 +42,9 @@ #:use-module (knots) #:use-module (knots queue) #:use-module (knots promise) + #:use-module (knots thread-pool) #:use-module (knots parallelism) #:use-module (knots resource-pool) - #:use-module (knots worker-threads) #:use-module (guix monads) #:use-module (guix base32) #:use-module (guix store) @@ -2271,19 +2271,17 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" #:key skip-system-tests? parallelism extra-inferior-environment-variables) (define call-with-utility-thread - (let* ((worker-thread-set + (let* ((thread-pool (call-with-default-io-waiters (lambda () - (make-worker-thread-set - (const '()) - #:parallelism parallelism)))) + (make-thread-pool parallelism)))) (queued-channel ;; There might be high demand for this, so order the requests (spawn-queueing-fiber - (worker-thread-set-channel worker-thread-set)))) + (thread-pool-channel thread-pool)))) (lambda (thunk) - (call-with-worker-thread - worker-thread-set + (call-with-thread + thread-pool thunk #:channel queued-channel)))) @@ -2804,7 +2802,7 @@ SKIP LOCKED") ;; instances have the data updated. (fix-derivation-output-details-hash-encoding conn) - (%worker-thread-default-timeout #f) + (%thread-pool-default-timeout #f) (resource-pool-retry-checkout-timeout 120) diff --git a/guix-data-service/utils.scm b/guix-data-service/utils.scm index a447a9c..c85bed3 100644 --- a/guix-data-service/utils.scm +++ b/guix-data-service/utils.scm @@ -44,8 +44,6 @@ with-time-logging prevent-inlining-for-tests - fiberize - chunk chunk! chunk-for-each! @@ -77,41 +75,6 @@ (define-syntax-rule (prevent-inlining-for-tests var) (set! var var)) -(define* (fiberize proc #:key (parallelism 1)) - (let ((channel (make-channel))) - (for-each - (lambda _ - (spawn-fiber - (lambda () - (while #t - (let ((reply-channel args (car+cdr - (get-message channel)))) - (put-message - reply-channel - (with-exception-handler - (lambda (exn) - (cons 'exception exn)) - (lambda () - (with-throw-handler #t - (lambda () - (call-with-values - (lambda () - (apply proc args)) - (lambda vals - (cons 'result vals)))) - (lambda _ - (backtrace)))) - #:unwind? #t))))) - #:parallel? #t)) - (iota parallelism)) - - (lambda args - (let ((reply-channel (make-channel))) - (put-message channel (cons reply-channel args)) - (match (get-message reply-channel) - (('result . vals) (apply values vals)) - (('exception . exn) (raise-exception exn))))))) - (define (chunk lst max-length) (if (> (length lst) max-length) diff --git a/guix-dev.scm b/guix-dev.scm index 138b18c..62b3836 100644 --- a/guix-dev.scm +++ b/guix-dev.scm @@ -42,7 +42,7 @@ (srfi srfi-1)) (define guile-knots - (let ((commit "6119ece5cba6cbdc638ccfb19aba52ea246dfe50") + (let ((commit "d572f591a3c136bfc7b23160e16381c92588f8d9") (revision "1")) (package (name "guile-knots") @@ -54,7 +54,7 @@ (commit commit))) (sha256 (base32 - "1dn9mrla0inhmfcyl725jh6dfwrg6xd56jp7c3n3plmjz3knyfmj")) + "0g85frfniblxb2cl81fg558ic3cxvla7fvml08scjgbbxn8151gv")) (file-name (string-append name "-" version "-checkout")))) (build-system gnu-build-system) (native-inputs