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

Avoid a vector->list

Browse source 
As the knots fibers utils accept vectors.
This commit is contained in:
Christopher Baines 2025-03-10 10:13:43 +00:00
parent f56cae63fc
commit 001805a2c9
1 changed files with 46 additions and 40 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -934,41 +934,41 @@
package-ids package-ids
lint-checker-ids lint-checker-ids
lint-warnings-data) lint-warnings-data)
(concatenate! (vector-fold
(filter-map (lambda (_ result lint-checker-id warnings-per-package)
(lambda (lint-checker-id warnings-per-package) (if warnings-per-package
(if warnings-per-package (vector-fold
(vector-fold (lambda (_ result package-id warnings)
(lambda (_ result package-id warnings) (if (null? warnings)
(if (null? warnings) result
result (cons
(cons (lint-warnings-data->lint-warning-ids
(lint-warnings-data->lint-warning-ids conn
conn (list->vector
(list->vector (map
(map (match-lambda
(match-lambda ((location-data messages-by-locale)
((location-data messages-by-locale) (let ((location-id
(let ((location-id (location->location-id
(location->location-id conn
conn (apply location location-data)))
(apply location location-data))) (lint-warning-message-set-id
(lint-warning-message-set-id (lint-warning-message-data->lint-warning-message-set-id
(lint-warning-message-data->lint-warning-message-set-id conn
conn messages-by-locale)))
messages-by-locale))) (list lint-checker-id
(list lint-checker-id package-id
package-id location-id
location-id lint-warning-message-set-id))))
lint-warning-message-set-id)))) warnings)))
warnings))) result)))
result))) result
'() package-ids
package-ids warnings-per-package)
warnings-per-package) result))
#f)) '()
(vector->list lint-checker-ids) lint-checker-ids
lint-warnings-data))) lint-warnings-data))
(define (update-derivation-ids-hash-table! conn (define (update-derivation-ids-hash-table! conn
derivation-ids-hash-table derivation-ids-hash-table
@ -1540,8 +1540,9 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(match res (match res
((inferior . inferior-store) ((inferior . inferior-store)
(let* ((systems (let* ((systems
(inferior-eval '(@ (guix packages) %supported-systems) '("x86_64-linux"))
inferior)) ;; (inferior-eval '(@ (guix packages) %supported-systems)
;; inferior))
(ignored-systems (ignored-systems
(lset-intersection string=? (lset-intersection string=?
systems systems
@ -2000,8 +2001,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(inferior-lint-warnings inferior (inferior-lint-warnings inferior
inferior-store inferior-store
checker-name))))))) checker-name)))))))
(vector->list inferior-lint-checkers-data)))
inferior-lint-checkers-data))))
(let ((package-ids (fibers-force package-ids-promise))) (let ((package-ids (fibers-force package-ids-promise)))
(with-resource-from-pool postgresql-connection-pool conn (with-resource-from-pool postgresql-connection-pool conn
@ -2095,7 +2095,13 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(round (round
(/ (assoc-ref stats 'heap-size) (/ (assoc-ref stats 'heap-size)
(expt 2. 20))))) (expt 2. 20)))))
inferior)) inferior)
;; (inferior-eval
;; '((@@ (guix memoization) show-memoization-tables))
;; inferior)
*unspecified*)
(define (get-derivations system target) (define (get-derivations system target)
(let ((derivations-vector (make-vector packages-count))) (let ((derivations-vector (make-vector packages-count)))