cbaines pushed a commit to branch trunk
in repository data-service.
commit 001805a2c951236b9cdf197465d707578faf8b2d
Author: Christopher Baines <[email protected]>
AuthorDate: Mon Mar 10 10:13:43 2025 +0000
Avoid a vector->list
As the knots fibers utils accept vectors.
---
guix-data-service/jobs/load-new-guix-revision.scm | 86 ++++++++++++-----------
1 file changed, 46 insertions(+), 40 deletions(-)
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm
b/guix-data-service/jobs/load-new-guix-revision.scm
index e0e0bc6..c69e2a9 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -934,41 +934,41 @@
package-ids
lint-checker-ids
lint-warnings-data)
- (concatenate!
- (filter-map
- (lambda (lint-checker-id warnings-per-package)
- (if warnings-per-package
- (vector-fold
- (lambda (_ result package-id warnings)
- (if (null? warnings)
- result
- (cons
- (lint-warnings-data->lint-warning-ids
- conn
- (list->vector
- (map
- (match-lambda
- ((location-data messages-by-locale)
- (let ((location-id
- (location->location-id
- conn
- (apply location location-data)))
- (lint-warning-message-set-id
-
(lint-warning-message-data->lint-warning-message-set-id
- conn
- messages-by-locale)))
- (list lint-checker-id
- package-id
- location-id
- lint-warning-message-set-id))))
- warnings)))
- result)))
- '()
- package-ids
- warnings-per-package)
- #f))
- (vector->list lint-checker-ids)
- lint-warnings-data)))
+ (vector-fold
+ (lambda (_ result lint-checker-id warnings-per-package)
+ (if warnings-per-package
+ (vector-fold
+ (lambda (_ result package-id warnings)
+ (if (null? warnings)
+ result
+ (cons
+ (lint-warnings-data->lint-warning-ids
+ conn
+ (list->vector
+ (map
+ (match-lambda
+ ((location-data messages-by-locale)
+ (let ((location-id
+ (location->location-id
+ conn
+ (apply location location-data)))
+ (lint-warning-message-set-id
+
(lint-warning-message-data->lint-warning-message-set-id
+ conn
+ messages-by-locale)))
+ (list lint-checker-id
+ package-id
+ location-id
+ lint-warning-message-set-id))))
+ warnings)))
+ result)))
+ result
+ package-ids
+ warnings-per-package)
+ result))
+ '()
+ lint-checker-ids
+ lint-warnings-data))
(define (update-derivation-ids-hash-table! conn
derivation-ids-hash-table
@@ -1540,8 +1540,9 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
(match res
((inferior . inferior-store)
(let* ((systems
- (inferior-eval '(@ (guix packages) %supported-systems)
- inferior))
+ '("x86_64-linux"))
+ ;; (inferior-eval '(@ (guix packages)
%supported-systems)
+ ;; inferior))
(ignored-systems
(lset-intersection string=?
systems
@@ -2000,8 +2001,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
(inferior-lint-warnings inferior
inferior-store
checker-name)))))))
- (vector->list
- inferior-lint-checkers-data))))
+ inferior-lint-checkers-data)))
(let ((package-ids (fibers-force package-ids-promise)))
(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
(/ (assoc-ref stats 'heap-size)
(expt 2. 20)))))
- inferior))
+ inferior)
+
+ ;; (inferior-eval
+ ;; '((@@ (guix memoization) show-memoization-tables))
+ ;; inferior)
+
+ *unspecified*)
(define (get-derivations system target)
(let ((derivations-vector (make-vector packages-count)))
