cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Update Guile Knots

Browse source
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
Download patch file Download diff file Expand all files Collapse all files

53
guix-data-service/jobs/load-new-guix-revision.scm
View file

@ -966,7 +966,7 @@
(chunk! missing-file-names 1000))))) (chunk! missing-file-names 1000)))))
(define* (insert-missing-derivations postgresql-connection-pool (define* (insert-missing-derivations postgresql-connection-pool
utility-thread-channel call-with-utility-thread
derivation-ids-hash-table derivation-ids-hash-table
unfiltered-derivations unfiltered-derivations
#:key (log-tag "unspecified")) #:key (log-tag "unspecified"))
@ -1081,10 +1081,9 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
id) id)
#t) #t)
(_ #f))) (_ #f)))
;; Use the utility-thread-channel to control concurrency here, ;; Use a utility thread to control concurrency here, to
;; to avoid using too much memory ;; avoid using too much memory
(call-with-worker-thread (call-with-utility-thread
utility-thread-channel
(lambda () (lambda ()
(let ((nar-bytevector (let ((nar-bytevector
(call-with-values (call-with-values
@ -1163,7 +1162,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(lambda (chunk) (lambda (chunk)
(insert-missing-derivations (insert-missing-derivations
postgresql-connection-pool postgresql-connection-pool
utility-thread-channel call-with-utility-thread
derivation-ids-hash-table derivation-ids-hash-table
chunk chunk
#:log-tag log-tag)) #:log-tag log-tag))
@ -1183,7 +1182,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
derivations)))))) derivations))))))
(define* (derivation-file-names->derivation-ids postgresql-connection-pool (define* (derivation-file-names->derivation-ids postgresql-connection-pool
utility-thread-channel call-with-utility-thread
read-derivations/fiberized read-derivations/fiberized
derivation-ids-hash-table derivation-ids-hash-table
derivation-file-names derivation-file-names
@ -1228,7 +1227,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
i i
log-tag) log-tag)
(insert-missing-derivations postgresql-connection-pool (insert-missing-derivations postgresql-connection-pool
utility-thread-channel call-with-utility-thread
derivation-ids-hash-table derivation-ids-hash-table
missing-derivations-chunk missing-derivations-chunk
#:log-tag log-tag))) #:log-tag log-tag)))
@ -1747,7 +1746,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
commit commit
guix-source store-item guix-source store-item
guix-derivation guix-derivation
utility-thread-channel call-with-utility-thread
read-derivations/fiberized read-derivations/fiberized
derivation-ids-hash-table derivation-ids-hash-table
#:key skip-system-tests? #:key skip-system-tests?
@ -1923,8 +1922,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
name name
network-dependent network-dependent
;; Uses of sort may cause problems ;; Uses of sort may cause problems
(call-with-worker-thread (call-with-utility-thread
utility-thread-channel
(lambda () (lambda ()
(lint-checker-description-data->lint-checker-description-set-id (lint-checker-description-data->lint-checker-description-set-id
conn conn
@ -2087,7 +2085,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
system target) system target)
(derivation-file-names->derivation-ids (derivation-file-names->derivation-ids
postgresql-connection-pool postgresql-connection-pool
utility-thread-channel call-with-utility-thread
read-derivations/fiberized read-derivations/fiberized
derivation-ids-hash-table derivation-ids-hash-table
derivations-vector derivations-vector
@ -2170,7 +2168,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(derivation-ids (derivation-ids
(derivation-file-names->derivation-ids (derivation-file-names->derivation-ids
postgresql-connection-pool postgresql-connection-pool
utility-thread-channel call-with-utility-thread
read-derivations/fiberized read-derivations/fiberized
derivation-ids-hash-table derivation-ids-hash-table
(list->vector (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) (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 read-derivations/fiberized
derivation-ids-hash-table derivation-ids-hash-table
git-repository-id commit git-repository-id commit
@ -2250,7 +2248,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(derivation-ids (derivation-ids
(derivation-file-names->derivation-ids (derivation-file-names->derivation-ids
postgresql-connection-pool postgresql-connection-pool
utility-thread-channel call-with-utility-thread
read-derivations/fiberized read-derivations/fiberized
derivation-ids-hash-table derivation-ids-hash-table
(list->vector (map cdr derivations-by-system))))) (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 (define* (load-new-guix-revision conn git-repository-id commit
#:key skip-system-tests? parallelism #:key skip-system-tests? parallelism
extra-inferior-environment-variables) extra-inferior-environment-variables)
(define utility-thread-channel (define call-with-utility-thread
;; There might be high demand for this, so order the requests (let* ((worker-thread-set
(spawn-queueing-fiber
(call-with-default-io-waiters (call-with-default-io-waiters
(lambda () (lambda ()
(make-worker-thread-channel (make-worker-thread-set
(const '()) (const '())
#:parallelism parallelism))))) #: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) (define (read-derivations filenames)
(call-with-worker-thread (call-with-utility-thread
utility-thread-channel
(lambda () (lambda ()
(map (lambda (filename) (map (lambda (filename)
(if (file-exists? 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 (let ((guix-source
channel-derivations-by-system channel-derivations-by-system
(fibers-force channel-derivations-by-system-promise))) (fibers-force channel-derivations-by-system-promise)))
(load-channel-instances utility-thread-channel (load-channel-instances call-with-utility-thread
read-derivations/fiberized read-derivations/fiberized
derivation-ids-hash-table derivation-ids-hash-table
git-repository-id commit 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 guix-revision-id-promise
commit guix-source store-item commit guix-source store-item
guix-derivation guix-derivation
utility-thread-channel call-with-utility-thread
read-derivations/fiberized read-derivations/fiberized
derivation-ids-hash-table derivation-ids-hash-table
#:skip-system-tests? #:skip-system-tests?

5
guix-dev.scm
View file

@ -42,7 +42,7 @@
(srfi srfi-1)) (srfi srfi-1))
(define guile-knots (define guile-knots
(let ((commit "0fab93e9ff5b16813ae1356c13d3c974d7277d81") (let ((commit "6119ece5cba6cbdc638ccfb19aba52ea246dfe50")
(revision "1")) (revision "1"))
(package (package
(name "guile-knots") (name "guile-knots")
@ -54,7 +54,7 @@
(commit commit))) (commit commit)))
(sha256 (sha256
(base32 (base32
"1x0wirq0db2704784ig00kz5kh8j6szp2gwm67wn714m1jbhz9ky")) "1dn9mrla0inhmfcyl725jh6dfwrg6xd56jp7c3n3plmjz3knyfmj"))
(file-name (string-append name "-" version "-checkout")))) (file-name (string-append name "-" version "-checkout"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
@ -62,6 +62,7 @@
autoconf autoconf
automake automake
guile-3.0 guile-3.0
guile-lib
guile-fibers)) guile-fibers))
(inputs (inputs
(list guile-3.0)) (list guile-3.0))