diff options
author | Christopher Baines <mail@cbaines.net> | 2022-01-12 18:18:15 +0000 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2022-01-12 18:18:15 +0000 |
commit | 21cb33a859a25ac6ba82f32e014ea642e2e62afc (patch) | |
tree | e068f8f4a7f8aa47016f6ad2a73ff126f04f11ff /guix-data-service/utils.scm | |
parent | 6102553d947c8ae2f321091916986b091b94cee0 (diff) | |
download | data-service-21cb33a859a25ac6ba82f32e014ea642e2e62afc.tar data-service-21cb33a859a25ac6ba82f32e014ea642e2e62afc.tar.gz |
Re-write insert-derivation-inputs in a more memory efficient manor
Previously it would compute a long list of strings, potentially more than
100,000 elements long, then split this string up and insert it in chunks. Only
then could memory be freed.
This new approach builds the strings in batches for the insertion query, then
moves on to the next batch. This should mean that more memory can be freed and
reused along the way.
Diffstat (limited to 'guix-data-service/utils.scm')
-rw-r--r-- | guix-data-service/utils.scm | 28 |
1 files changed, 27 insertions, 1 deletions
diff --git a/guix-data-service/utils.scm b/guix-data-service/utils.scm index 4f66c9c..483f3ee 100644 --- a/guix-data-service/utils.scm +++ b/guix-data-service/utils.scm @@ -32,7 +32,8 @@ letpar& chunk - chunk!)) + chunk! + chunk-map!)) (define (call-with-time-logging action thunk) (simple-format #t "debug: Starting ~A\n" action) @@ -175,3 +176,28 @@ (cons first-lst (chunk! rest max-length)))) (list lst))) + +(define* (chunk-map! proc chunk-size #:rest lsts) + (define (do-one-iteration lsts) + (if (> (length (car lsts)) + chunk-size) + (let ((chunks-and-rest + (map (lambda (lst) + (call-with-values (lambda () + (split-at! lst chunk-size)) + (lambda (first-lst rest) + (cons first-lst + rest)))) + lsts))) + (apply proc + (map car chunks-and-rest)) + (do-one-iteration + (map cdr chunks-and-rest))) + (apply proc lsts))) + + (unless (eq? 1 + (length (delete-duplicates + (map length lsts)))) + (error "lists not equal length")) + + (do-one-iteration lsts)) |