Compute package derivations in chunks

This allows for keeping the inferiors and store connections around for a more
constant period, and allows closing the store connections and allowing the
guix-daemon to clear the WAL file if needed.

guix-data-service/jobs/load-new-guix-revision.scm

@@ -405,7 +405,7 @@
   (append supported-system-pairs
           supported-system-cross-build-pairs))
 
-(define (inferior-package-derivations store inf system target)
+(define (inferior-package-derivations store inf system target start-index count)
   (define proc
     `(lambda (store)
        (define system-target-pair
@@ -511,8 +511,12 @@
            (/ (assoc-ref stats 'heap-size)
               (expt 2. 20)))))
 
-       (vector-map
+       (let ((vec (list->vector
-        (lambda (_ package)
+                   (iota ,count ,start-index))))
+         (vector-map!
+          (lambda (_ index)
+            (define package (vector-ref gds-inferior-packages index))
+
             (catch
               #t
               (lambda ()
@@ -567,7 +571,8 @@
                        key
                        args)
                       #f)))))
-        gds-inferior-packages)))
+          vec)
+         vec)))
 
   (inferior-eval
    '(when (defined? 'systems (resolve-module '(guix platform)))
@@ -1449,10 +1454,9 @@
      1
      #:min-size 0))
 
-  (define package-ids-promise
+  (define packages-data-promise
     (fibers-delay
      (lambda ()
-       (let ((packages-data
        (with-resource-from-pool inf-and-store-pool res
          (match res
            ((inferior . inferior-store)
@@ -1463,7 +1467,12 @@
                 (all-inferior-packages-data
                  inferior
                  packages
-                        pkg-to-replacement-hash-table))))))))
+                 pkg-to-replacement-hash-table)))))))))
+
+  (define package-ids-promise
+    (fibers-delay
+     (lambda ()
+       (let ((packages-data (fibers-force packages-data-promise)))
          (with-resource-from-pool postgresql-connection-pool conn
            (insert-packages conn packages-data))))))
 
@@ -1524,6 +1533,13 @@
                lint-warning-ids)))))))
 
   (define (extract-and-store-package-derivations)
+    (define packages-count
+      (vector-length
+       (assq-ref (fibers-force packages-data-promise)
+                 'names)))
+
+    (define chunk-size 3000)
+
     (fibers-for-each
      (match-lambda
        ((system . target)
@@ -1535,10 +1551,15 @@
             (sleep 30)
             (loop (stat:size (stat "/var/guix/db/db.sqlite-wal")))))
 
-        (let ((derivations-vector
+        (let ((derivations-vector (make-vector packages-count)))
-               (with-resource-from-pool inf-and-store-pool res
           (with-time-logging
               (simple-format #f "getting derivations for ~A" (cons system target))
+            (let loop ((start-index 0))
+              (if (>= (+ start-index chunk-size) packages-count)
+                  (let* ((remaining-count
+                          (- packages-count start-index))
+                         (chunk
+                          (with-resource-from-pool inf-and-store-pool res
                             (match res
                               ((inferior . inferior-store)
                                (ensure-gds-inferior-packages-defined! inferior)
@@ -1547,7 +1568,29 @@
                                 inferior-store
                                 inferior
                                 system
-                       target)))))))
+                                target
+                                start-index
+                                remaining-count))))))
+                    (vector-copy! derivations-vector
+                                  start-index
+                                  chunk))
+                  (let ((chunk
+                         (with-resource-from-pool inf-and-store-pool res
+                           (match res
+                             ((inferior . inferior-store)
+                              (ensure-gds-inferior-packages-defined! inferior)
+
+                              (inferior-package-derivations
+                               inferior-store
+                               inferior
+                               system
+                               target
+                               start-index
+                               chunk-size))))))
+                    (vector-copy! derivations-vector
+                                  start-index
+                                  chunk)
+                    (loop (+ start-index chunk-size))))))
 
           (let ((package-ids (fibers-force package-ids-promise)))
             (with-resource-from-pool postgresql-connection-pool conn