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

Replace derivation-file-names->vhash

Browse source 
Rather than creating vhashes, just update the hash table that is used as a
cache, and query that. This should speed things up and reduce memory usage
when loading derivations.
This commit is contained in:
Christopher Baines 2021-09-24 17:14:40 +01:00
parent 261552bd5e
commit 947cabb685
1 changed files with 79 additions and 100 deletions
Download patch file Download diff file Expand all files Collapse all files

113
guix-data-service/model/derivation.scm
View file

@ -1498,17 +1498,17 @@ LIMIT $1"
(simple-format (simple-format
#t "debug: ensure-input-derivations-exist: processing ~A derivations\n" #t "debug: ensure-input-derivations-exist: processing ~A derivations\n"
(length input-derivation-file-names)) (length input-derivation-file-names))
(let ((existing-derivation-entries
(derivation-file-names->vhash conn (update-derivation-ids-hash-table! conn
derivation-ids-hash-table derivation-ids-hash-table
input-derivation-file-names))) input-derivation-file-names)
(simple-format (simple-format
#t #t
"debug: ensure-input-derivations-exist: checking for missing input derivations\n") "debug: ensure-input-derivations-exist: checking for missing input derivations\n")
(let ((missing-derivations-filenames (let ((missing-derivations-filenames
(filter (lambda (derivation-file-name) (filter (lambda (derivation-file-name)
(not (vhash-assoc derivation-file-name (not (hash-ref derivation-ids-hash-table
existing-derivation-entries))) derivation-file-name)))
input-derivation-file-names))) input-derivation-file-names)))
(unless (null? missing-derivations-filenames) (unless (null? missing-derivations-filenames)
@ -1520,7 +1520,7 @@ LIMIT $1"
conn conn
derivation-ids-hash-table derivation-ids-hash-table
(map read-derivation-from-file (map read-derivation-from-file
missing-derivations-filenames))))))) missing-derivations-filenames))))))
(define (insert-into-derivations) (define (insert-into-derivations)
(string-append (string-append
@ -1698,46 +1698,33 @@ WHERE " criteria ";"))
'() '()
sorted-derivations)) sorted-derivations))
(define (derivation-file-names->vhash conn derivation-ids-hash-table file-names) (define (update-derivation-ids-hash-table! conn
(simple-format #t "debug: derivation-file-names->vhash: ~A file-names\n" derivation-ids-hash-table
(length file-names))
(match (fold (match-lambda*
((file-name (result . missing-file-names))
(let ((cached-id (hash-ref derivation-ids-hash-table
file-name)))
(if cached-id
(cons (vhash-cons file-name cached-id result)
missing-file-names)
(cons result
(cons file-name missing-file-names))))))
(cons vlist-null '())
file-names) file-names)
((result) (define file-names-count (length file-names))
(simple-format
#t "debug: derivation-file-names->vhash: lookup ~A file-names, all found\n" (simple-format #t "debug: update-derivation-ids-hash-table!: ~A file-names\n"
(length file-names)) file-names-count)
result) (let ((missing-file-names
((result . missing-file-names) (fold (lambda (file-name result)
(simple-format (if (hash-ref derivation-ids-hash-table
#t "debug: derivation-file-names->vhash: lookup ~A file-names, ~A not cached\n" file-name)
(length file-names) (length missing-file-names))
(let ((result-for-missing-file-names
(exec-query->vhash
conn
(select-existing-derivations missing-file-names)
second ;; file_name
(lambda (result)
(string->number (first result)))))) ;; id
(simple-format
#t "debug: derivation-file-names->vhash: adding ~A entries to the cache\n"
(vlist-length result-for-missing-file-names))
(vhash-fold
(lambda (key value combined)
;; Update the derivation-ids-hash-table as we go through the vhash
(hash-set! derivation-ids-hash-table key value)
(vhash-cons key value combined))
result result
result-for-missing-file-names))))) (cons file-name result)))
'()
file-names)))
(simple-format
#t "debug: update-derivation-ids-hash-table!: lookup ~A file-names, ~A not cached\n"
file-names-count (length missing-file-names))
(for-each
(match-lambda
((id file-name)
(hash-set! derivation-ids-hash-table
file-name
(string->number id))))
(exec-query conn (select-existing-derivations missing-file-names)))))
(define (derivation-file-names->derivation-ids conn derivation-file-names) (define (derivation-file-names->derivation-ids conn derivation-file-names)
(define (select-source-files-missing-nars derivation-ids) (define (select-source-files-missing-nars derivation-ids)
@ -1809,38 +1796,30 @@ INNER JOIN derivation_source_files
(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)
(let* ((existing-derivation-entries
(derivation-file-names->vhash conn
derivation-ids-hash-table
derivation-file-names))
(missing-derivations (update-derivation-ids-hash-table! conn
derivation-ids-hash-table
derivation-file-names)
(let ((missing-derivations
(map read-derivation-from-file (map read-derivation-from-file
(deduplicate-strings (deduplicate-strings
(filter (lambda (derivation-file-name) (filter (lambda (derivation-file-name)
(not (vhash-assoc derivation-file-name (not (hash-ref derivation-ids-hash-table
existing-derivation-entries))) derivation-file-name)))
derivation-file-names)))) derivation-file-names)))))
(new-derivation-entries (unless (null? missing-derivations)
(if (null? missing-derivations)
'()
(insert-missing-derivations conn (insert-missing-derivations conn
derivation-ids-hash-table derivation-ids-hash-table
missing-derivations))) missing-derivations))
(new-entries-id-lookup-vhash
(two-lists->vhash (map derivation-file-name missing-derivations)
new-derivation-entries))
(all-ids (let ((all-ids
(map (lambda (derivation-file-name) (map (lambda (derivation-file-name)
(cdr (or (hash-ref derivation-ids-hash-table
(or (vhash-assoc derivation-file-name derivation-file-name)
existing-derivation-entries) (error "missing derivation id")))
(vhash-assoc derivation-file-name
new-entries-id-lookup-vhash)
(error "missing derivation id"))))
derivation-file-names))) derivation-file-names)))
(with-time-logging "inserting missing source files" (with-time-logging "inserting missing source files"
@ -1852,4 +1831,4 @@ INNER JOIN derivation_source_files
store-path))) store-path)))
(select-source-files-missing-nars all-ids))) (select-source-files-missing-nars all-ids)))
all-ids)))) all-ids)))))