cbaines pushed a commit to branch master
in repository data-service.
commit 93eac06fd6d948a0fb893e0acd01f587285df175
Author: Christopher Baines <[email protected]>
AuthorDate: Sun Dec 29 11:05:07 2024 +0000
Update Guile Knots
---
guix-data-service/jobs/load-new-guix-revision.scm | 59 ++++++++++++-----------
guix-dev.scm | 5 +-
2 files changed, 35 insertions(+), 29 deletions(-)
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm
b/guix-data-service/jobs/load-new-guix-revision.scm
index e18528a..83a43a0 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -966,7 +966,7 @@
(chunk! missing-file-names 1000)))))
(define* (insert-missing-derivations postgresql-connection-pool
- utility-thread-channel
+ call-with-utility-thread
derivation-ids-hash-table
unfiltered-derivations
#:key (log-tag "unspecified"))
@@ -1081,10 +1081,9 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
id)
#t)
(_ #f)))
- ;; Use the utility-thread-channel to control concurrency
here,
- ;; to avoid using too much memory
- (call-with-worker-thread
- utility-thread-channel
+ ;; Use a utility thread to control concurrency here, to
+ ;; avoid using too much memory
+ (call-with-utility-thread
(lambda ()
(let ((nar-bytevector
(call-with-values
@@ -1163,7 +1162,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
(lambda (chunk)
(insert-missing-derivations
postgresql-connection-pool
- utility-thread-channel
+ call-with-utility-thread
derivation-ids-hash-table
chunk
#:log-tag log-tag))
@@ -1183,7 +1182,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
derivations))))))
(define* (derivation-file-names->derivation-ids postgresql-connection-pool
- utility-thread-channel
+ call-with-utility-thread
read-derivations/fiberized
derivation-ids-hash-table
derivation-file-names
@@ -1228,7 +1227,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
i
log-tag)
(insert-missing-derivations postgresql-connection-pool
- utility-thread-channel
+ call-with-utility-thread
derivation-ids-hash-table
missing-derivations-chunk
#:log-tag log-tag)))
@@ -1747,7 +1746,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
commit
guix-source store-item
guix-derivation
- utility-thread-channel
+ call-with-utility-thread
read-derivations/fiberized
derivation-ids-hash-table
#:key skip-system-tests?
@@ -1923,8 +1922,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
name
network-dependent
;; Uses of sort may cause problems
- (call-with-worker-thread
- utility-thread-channel
+ (call-with-utility-thread
(lambda ()
(lint-checker-description-data->lint-checker-description-set-id
conn
@@ -2087,7 +2085,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
system target)
(derivation-file-names->derivation-ids
postgresql-connection-pool
- utility-thread-channel
+ call-with-utility-thread
read-derivations/fiberized
derivation-ids-hash-table
derivations-vector
@@ -2170,7 +2168,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
(derivation-ids
(derivation-file-names->derivation-ids
postgresql-connection-pool
- utility-thread-channel
+ call-with-utility-thread
read-derivations/fiberized
derivation-ids-hash-table
(list->vector
@@ -2200,7 +2198,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
(prevent-inlining-for-tests extract-information-from)
-(define (load-channel-instances utility-thread-channel
+(define (load-channel-instances call-with-utility-thread
read-derivations/fiberized
derivation-ids-hash-table
git-repository-id commit
@@ -2250,7 +2248,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
(derivation-ids
(derivation-file-names->derivation-ids
postgresql-connection-pool
- utility-thread-channel
+ call-with-utility-thread
read-derivations/fiberized
derivation-ids-hash-table
(list->vector (map cdr derivations-by-system)))))
@@ -2271,18 +2269,25 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
(define* (load-new-guix-revision conn git-repository-id commit
#:key skip-system-tests? parallelism
extra-inferior-environment-variables)
- (define utility-thread-channel
- ;; There might be high demand for this, so order the requests
- (spawn-queueing-fiber
- (call-with-default-io-waiters
- (lambda ()
- (make-worker-thread-channel
- (const '())
- #:parallelism parallelism)))))
+ (define call-with-utility-thread
+ (let* ((worker-thread-set
+ (call-with-default-io-waiters
+ (lambda ()
+ (make-worker-thread-set
+ (const '())
+ #:parallelism parallelism))))
+ (queued-channel
+ ;; There might be high demand for this, so order the requests
+ (spawn-queueing-fiber
+ (worker-thread-set-channel worker-thread-set))))
+ (lambda (thunk)
+ (call-with-worker-thread
+ worker-thread-set
+ thunk
+ #:channel queued-channel))))
(define (read-derivations filenames)
- (call-with-worker-thread
- utility-thread-channel
+ (call-with-utility-thread
(lambda ()
(map (lambda (filename)
(if (file-exists? filename)
@@ -2331,7 +2336,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
(let ((guix-source
channel-derivations-by-system
(fibers-force channel-derivations-by-system-promise)))
- (load-channel-instances utility-thread-channel
+ (load-channel-instances call-with-utility-thread
read-derivations/fiberized
derivation-ids-hash-table
git-repository-id commit
@@ -2358,7 +2363,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
guix-revision-id-promise
commit guix-source store-item
guix-derivation
- utility-thread-channel
+ call-with-utility-thread
read-derivations/fiberized
derivation-ids-hash-table
#:skip-system-tests?
diff --git a/guix-dev.scm b/guix-dev.scm
index eec15ec..138b18c 100644
--- a/guix-dev.scm
+++ b/guix-dev.scm
@@ -42,7 +42,7 @@
(srfi srfi-1))
(define guile-knots
- (let ((commit "0fab93e9ff5b16813ae1356c13d3c974d7277d81")
+ (let ((commit "6119ece5cba6cbdc638ccfb19aba52ea246dfe50")
(revision "1"))
(package
(name "guile-knots")
@@ -54,7 +54,7 @@
(commit commit)))
(sha256
(base32
- "1x0wirq0db2704784ig00kz5kh8j6szp2gwm67wn714m1jbhz9ky"))
+ "1dn9mrla0inhmfcyl725jh6dfwrg6xd56jp7c3n3plmjz3knyfmj"))
(file-name (string-append name "-" version "-checkout"))))
(build-system gnu-build-system)
(native-inputs
@@ -62,6 +62,7 @@
autoconf
automake
guile-3.0
+ guile-lib
guile-fibers))
(inputs
(list guile-3.0))
