From d310632f26bfbb9272a5f4019f66045256327702 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sun, 3 Nov 2024 21:24:30 +0000
Subject: Move the inferior cleanup to the end of each system+target

---
 guix-data-service/jobs/load-new-guix-revision.scm | 52 ++++++++++++++---------
 1 file changed, 32 insertions(+), 20 deletions(-)

(limited to 'guix-data-service')

diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm
index fa1d01a..0d09b54 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -620,19 +620,6 @@
      '(define unsupported-cross-compilation-target-error? (const #f))
      inf))
 
-  (catch
-    'match-error
-    (lambda ()
-      (inferior-eval '(invalidate-derivation-caches!) inf))
-    (lambda (key . args)
-      (simple-format
-       (current-error-port)
-       "warning: ignoring match-error from calling inferior invalidate-derivation-caches!\n")))
-
-  ;; Clean the cached store connections, as there are caches associated
-  ;; with these that take up lots of memory
-  (inferior-eval '(when (defined? '%store-table) (hash-clear! %store-table)) inf)
-
   (inferior-eval-with-store/non-blocking
    inf
    store
@@ -1939,6 +1926,25 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
 
     (define chunk-size 1000)
 
+    (define (inferior-cleanup inferior)
+      (catch
+        'match-error
+        (lambda ()
+          (inferior-eval '(invalidate-derivation-caches!)
+                         inferior))
+        (lambda (key . args)
+          (simple-format
+           (current-error-port)
+           "warning: ignoring match-error from calling inferior invalidate-derivation-caches!\n")))
+
+      ;; Clean the cached store connections, as there are
+      ;; caches associated with these that take up lots of
+      ;; memory
+      (inferior-eval
+       '(when (defined? '%store-table)
+          (hash-clear! %store-table))
+       inferior))
+
     (define (get-derivations system target)
       (let ((derivations-vector (make-vector packages-count)))
         (with-time-logging
@@ -1955,13 +1961,19 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
                      (lambda (inferior inferior-store)
                        (ensure-gds-inferior-packages-defined! inferior)
 
-                       (inferior-package-derivations
-                        inferior-store
-                        inferior
-                        system
-                        target
-                        start-index
-                        count)))))
+                       (let ((result
+                              (inferior-package-derivations
+                               inferior-store
+                               inferior
+                               system
+                               target
+                               start-index
+                               count)))
+
+                         (when last-chunk?
+                           (inferior-cleanup inferior))
+
+                         result)))))
               (vector-copy! derivations-vector
                             start-index
                             chunk)
-- 
cgit v1.2.3