Use a common derivation-ids-hash-table

To allow for calling derivation-file-names->derivation-ids in parallel across
multiple fibers, using the PostgreSQL connection fiber to perform atomic
operations.
This commit is contained in:
Christopher Baines 2024-10-27 13:58:19 +00:00
parent 38d5501233
commit 1e0407e9b6

View file

@ -1148,16 +1148,14 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(define (derivation-file-names->derivation-ids postgresql-connection-pool (define (derivation-file-names->derivation-ids postgresql-connection-pool
utility-thread-channel utility-thread-channel
derivation-ids-hash-table
derivation-file-names) derivation-file-names)
(define derivations-count (define derivations-count
(vector-length derivation-file-names)) (vector-length derivation-file-names))
(if (= 0 derivations-count) (if (= 0 derivations-count)
#() #()
(let* ((derivation-ids-hash-table (make-hash-table (begin
;; Account for more derivations in
;; the graph
(* 2 derivations-count))))
(simple-format (simple-format
#t "debug: derivation-file-names->derivation-ids: processing ~A derivations\n" #t "debug: derivation-file-names->derivation-ids: processing ~A derivations\n"
derivations-count) derivations-count)
@ -1698,6 +1696,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
guix-source store-item guix-source store-item
guix-derivation guix-derivation
utility-thread-channel utility-thread-channel
derivation-ids-hash-table
#:key skip-system-tests? #:key skip-system-tests?
extra-inferior-environment-variables extra-inferior-environment-variables
parallelism) parallelism)
@ -1827,14 +1826,6 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
1 1
#:min-size 0)) #:min-size 0))
(define derivation-file-names->derivation-ids/fiberized
(fiberize
(lambda (derivation-file-names)
(derivation-file-names->derivation-ids
postgresql-connection-pool
utility-thread-channel
derivation-file-names))))
(define package-ids-promise (define package-ids-promise
(fibers-delay (fibers-delay
(lambda () (lambda ()
@ -1955,7 +1946,10 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(with-time-logging (with-time-logging
(simple-format #f "derivation-file-names->derivation-ids (~A ~A)" (simple-format #f "derivation-file-names->derivation-ids (~A ~A)"
system target) system target)
(derivation-file-names->derivation-ids/fiberized (derivation-file-names->derivation-ids
postgresql-connection-pool
utility-thread-channel
derivation-ids-hash-table
derivations-vector))) derivations-vector)))
(guix-revision-id (guix-revision-id
(fibers-force guix-revision-id-promise)) (fibers-force guix-revision-id-promise))
@ -2029,7 +2023,10 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(let ((systems (let ((systems
(map car derivation-file-names-by-system)) (map car derivation-file-names-by-system))
(derivation-ids (derivation-ids
(derivation-file-names->derivation-ids/fiberized (derivation-file-names->derivation-ids
postgresql-connection-pool
utility-thread-channel
derivation-ids-hash-table
(list->vector (list->vector
(map cdr derivation-file-names-by-system))))) (map cdr derivation-file-names-by-system)))))
(map cons systems derivation-ids)) (map cons systems derivation-ids))
@ -2054,6 +2051,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 utility-thread-channel
derivation-ids-hash-table
git-repository-id commit git-repository-id commit
channel-derivations-by-system) channel-derivations-by-system)
;; Load the channel instances in a different transaction, so that this can ;; Load the channel instances in a different transaction, so that this can
@ -2101,6 +2099,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(derivation-file-names->derivation-ids (derivation-file-names->derivation-ids
postgresql-connection-pool postgresql-connection-pool
utility-thread-channel utility-thread-channel
derivation-ids-hash-table
(list->vector (map cdr derivations-by-system))))) (list->vector (map cdr derivations-by-system)))))
(insert-channel-instances channel-instances-conn (insert-channel-instances channel-instances-conn
@ -2124,6 +2123,9 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(const '()) (const '())
#:parallelism parallelism)) #:parallelism parallelism))
(define derivation-ids-hash-table
(make-hash-table))
(%worker-thread-default-timeout #f) (%worker-thread-default-timeout #f)
(let* ((git-repository-fields (let* ((git-repository-fields
@ -2155,6 +2157,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
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 utility-thread-channel
derivation-ids-hash-table
git-repository-id commit git-repository-id commit
channel-derivations-by-system))) channel-derivations-by-system)))
#:on-exception #:on-exception
@ -2180,6 +2183,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
commit guix-source store-item commit guix-source store-item
guix-derivation guix-derivation
utility-thread-channel utility-thread-channel
derivation-ids-hash-table
#:skip-system-tests? #:skip-system-tests?
skip-system-tests? skip-system-tests?
#:extra-inferior-environment-variables #:extra-inferior-environment-variables