Make some sweeping changes to loading new revisions

Move in the direction of being able to run multiple inferior REPLs, and use
some vectors rather than lists in places (maybe this is more efficient).

5 files changed, 103 insertions, 68 deletions

diff --git a/guix-data-service/model/channel-instance.scm b/guix-data-service/model/channel-instance.scm
index 956018e..84fc901 100644
--- a/guix-data-service/model/channel-instance.scm
+++ b/guix-data-service/model/channel-instance.scm
@@ -33,7 +33,8 @@
   (let ((derivation-ids
          (derivation-file-names->derivation-ids
           conn
-          (map cdr derivations-by-system))))
+          (list->vector
+           (map cdr derivations-by-system)))))
 
     (exec-query
      conn
@@ -49,7 +50,7 @@ VALUES "
                              system
                              derivation-id))
             (map car derivations-by-system)
-            derivation-ids)
+            (vector->list derivation-ids))
        ", "))))
   #t)
 
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)))))
 
diff --git a/guix-data-service/model/license.scm b/guix-data-service/model/license.scm
index 9104882..ebca0eb 100644
--- a/guix-data-service/model/license.scm
+++ b/guix-data-service/model/license.scm
@@ -28,39 +28,39 @@
 (define inferior-package-id
   (@@ (guix inferior) inferior-package-id))
 
-(define (inferior-packages->license-data inf packages)
-  (define (proc packages)
-    `(map (lambda (inferior-package-id)
-            (let ((package (hashv-ref %package-table inferior-package-id)))
-              (match (package-license package)
-                ((? license? license)
-                 (list
-                  (list (license-name license)
-                        (license-uri license)
-                        (license-comment license))))
-                ((values ...)
-                 (map (match-lambda
-                        ((? license? license)
-                         (list (license-name license)
-                               (license-uri license)
-                               (license-comment license)))
-                        (x
-                         (simple-format
-                          (current-error-port)
-                          "error: unknown license value ~A for package ~A"
-                          x package)
-                         '()))
-                      values))
-                (x
-                 (simple-format
-                  (current-error-port)
-                  "error: unknown license value ~A for package ~A"
-                  x package)
-                 '()))))
-          (list ,@(map inferior-package-id packages))))
+(define (inferior-packages->license-data inf)
+  (define proc
+    `(vector-map
+      (lambda (_ package)
+        (match (package-license package)
+          ((? license? license)
+           (list
+            (list (license-name license)
+                  (license-uri license)
+                  (license-comment license))))
+          ((values ...)
+           (map (match-lambda
+                  ((? license? license)
+                   (list (license-name license)
+                         (license-uri license)
+                         (license-comment license)))
+                  (x
+                   (simple-format
+                    (current-error-port)
+                    "error: unknown license value ~A for package ~A"
+                    x package)
+                   '()))
+                values))
+          (x
+           (simple-format
+            (current-error-port)
+            "error: unknown license value ~A for package ~A"
+            x package)
+           '())))
+      gds-inferior-packages))
 
   (inferior-eval '(use-modules (guix licenses)) inf)
-  (inferior-eval (proc packages) inf))
+  (inferior-eval proc inf))
 
 (define (inferior-packages->license-id-lists conn license-data)
   (define (string-or-null v)
diff --git a/guix-data-service/model/package-derivation.scm b/guix-data-service/model/package-derivation.scm
index 109e0f1..2008409 100644
--- a/guix-data-service/model/package-derivation.scm
+++ b/guix-data-service/model/package-derivation.scm
@@ -17,6 +17,7 @@
 
 (define-module (guix-data-service model package-derivation)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-43)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 match)
   #:use-module (squee)
@@ -26,17 +27,26 @@
             count-packages-derivations-in-revision))
 
 (define (insert-package-derivations conn
-                                    package-ids-systems-and-targets
+                                    system
+                                    target
+                                    package-ids
                                     derivation-ids)
+  (define system-id
+    (system->system-id conn system))
+
   (define data-4-tuples
-    (map (match-lambda*
-           (((package-id system target) derivation-id)
-            (list package-id
-                  derivation-id
-                  (system->system-id conn system)
-                  target)))
-         package-ids-systems-and-targets
-         derivation-ids))
+    (vector-fold
+     (lambda (_ result package-id derivation-id)
+       (if derivation-id
+           (cons (list package-id
+                       derivation-id
+                       system-id
+                       target)
+                 result)
+           result))
+     '()
+     package-ids
+     derivation-ids))
 
   (if (null? data-4-tuples)
       '()
diff --git a/guix-data-service/model/package.scm b/guix-data-service/model/package.scm
index 7ec2b09..263f46c 100644
--- a/guix-data-service/model/package.scm
+++ b/guix-data-service/model/package.scm
@@ -264,11 +264,12 @@ INSERT INTO packages (name, version, package_metadata_id) VALUES "
 RETURNING id"))
 
 (define (inferior-packages->package-ids conn package-entries)
-  (insert-missing-data-and-return-all-ids
-   conn
-   "packages"
-   '(name version package_metadata_id replacement_package_id)
-   package-entries))
+  (list->vector
+   (insert-missing-data-and-return-all-ids
+    conn
+    "packages"
+    '(name version package_metadata_id replacement_package_id)
+    package-entries)))
 
 (define (select-package-versions-for-revision conn
                                               commit