Update Guile Knots

This commit is contained in:
Christopher Baines 2024-12-29 11:05:07 +00:00
parent 62d6b59013
commit 93eac06fd6
2 changed files with 35 additions and 29 deletions

View file

@ -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?

View file

@ -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))