diff options
Diffstat (limited to 'guix-data-service/model/derivation.scm')
| -rw-r--r-- | guix-data-service/model/derivation.scm | 65 |
1 files changed, 44 insertions, 21 deletions
diff --git a/guix-data-service/model/derivation.scm b/guix-data-service/model/derivation.scm index 20f481a..98c2178 100644 --- a/guix-data-service/model/derivation.scm +++ b/guix-data-service/model/derivation.scm @@ -17,6 +17,7 @@ (define-module (guix-data-service model derivation) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-43) #:use-module (ice-9 vlist) #:use-module (ice-9 match) #:use-module (ice-9 format) @@ -1545,7 +1546,8 @@ LIMIT $1" (update-derivation-ids-hash-table! conn derivation-ids-hash-table - input-derivation-file-names) + (list->vector + input-derivation-file-names)) (simple-format #t "debug: ensure-input-derivations-exist: checking for missing input derivations\n") @@ -1743,18 +1745,20 @@ WHERE " criteria ";")) (define (update-derivation-ids-hash-table! conn derivation-ids-hash-table file-names) - (define file-names-count (length file-names)) + (define file-names-count (vector-length file-names)) (simple-format #t "debug: update-derivation-ids-hash-table!: ~A file-names\n" file-names-count) (let ((missing-file-names - (fold (lambda (file-name result) - (if (hash-ref derivation-ids-hash-table - file-name) - result - (cons file-name result))) - '() - file-names))) + (vector-fold + (lambda (_ result file-name) + (if (and file-name + (hash-ref derivation-ids-hash-table + file-name)) + result + (cons file-name result))) + '() + file-names))) (simple-format #t "debug: update-derivation-ids-hash-table!: lookup ~A file-names, ~A not cached\n" @@ -1773,6 +1777,9 @@ WHERE " criteria ";")) (chunk! missing-file-names 1000))))) (define (derivation-file-names->derivation-ids conn derivation-file-names) + (define derivations-count + (vector-length derivation-file-names)) + (define (insert-source-files-missing-nars derivation-ids) (define (derivation-ids->next-related-derivation-ids! ids seen-ids) (delete-duplicates/sort! @@ -1862,10 +1869,9 @@ INNER JOIN derivation_source_files next-related-derivation-ids seen-ids))))))) - (if (null? derivation-file-names) - '() - (let* ((derivations-count (length derivation-file-names)) - (derivation-ids-hash-table (make-hash-table + (if (= 0 derivations-count) + #() + (let* ((derivation-ids-hash-table (make-hash-table ;; Account for more derivations in ;; the graph (* 2 derivations-count)))) @@ -1879,10 +1885,16 @@ INNER JOIN derivation_source_files (let ((missing-derivation-filenames (deduplicate-strings - (filter (lambda (derivation-file-name) - (not (hash-ref derivation-ids-hash-table - derivation-file-name))) - derivation-file-names)))) + (vector-fold + (lambda (_ result derivation-file-name) + (if (not derivation-file-name) + result + (if (hash-ref derivation-ids-hash-table + derivation-file-name) + result + (cons derivation-file-name result)))) + '() + derivation-file-names)))) (chunk-for-each! (lambda (missing-derivation-filenames-chunk) @@ -1907,14 +1919,25 @@ INNER JOIN derivation_source_files missing-derivation-filenames) (let ((all-ids - (map (lambda (derivation-file-name) + (vector-map + (lambda (_ derivation-file-name) + (if derivation-file-name (or (hash-ref derivation-ids-hash-table derivation-file-name) - (error "missing derivation id"))) - derivation-file-names))) + (error "missing derivation id")) + #f)) + derivation-file-names))) (with-time-logging "insert-source-files-missing-nars" - (insert-source-files-missing-nars all-ids)) + (insert-source-files-missing-nars + ;; TODO Avoid this conversion + (vector-fold + (lambda (_ result x) + (if x + (cons x result) + result)) + '() + all-ids))) all-ids))))) |