02/03: derivations: Simplify 'substitution-oracle'.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit d74392a85cfd0992d034b903ca21180a6d73eaed
Author: Ludovic Courtès <address@hidden>
Date:   Fri Jul 5 00:09:27 2019 +0200

    derivations: Simplify 'substitution-oracle'.
    
    * guix/derivations.scm (substitution-oracle)[valid?, dependencies]:
    Remove.
    [closure]: New procedure.
    Rename parameter from 'drv' to 'inputs-or-drv' and adjust accordingly.
    (derivation-build-plan): Pass INPUTS directly to 'substitution-oracle'.
    * guix/ui.scm (show-what-to-build)[substitutable-info]: Likewise.
---
 guix/derivations.scm | 86 ++++++++++++++++++++++++----------------------------
 guix/ui.scm          |  3 +-
 2 files changed, 41 insertions(+), 48 deletions(-)

diff --git a/guix/derivations.scm b/guix/derivations.scm
index caa76bd..731f1f6 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -293,60 +293,57 @@ result is the set of prerequisites of DRV not already in 
valid."
             (derivation-output-path (assoc-ref outputs sub-drv)))
           sub-drvs))))
 
-(define* (substitution-oracle store drv
+(define* (substitution-oracle store inputs-or-drv
                               #:key (mode (build-mode normal)))
   "Return a one-argument procedure that, when passed a store file name,
 returns a 'substitutable?' if it's substitutable and #f otherwise.
-The returned procedure
-knows about all substitutes for all the derivations listed in DRV, *except*
-those that are already valid (that is, it won't bother checking whether an
-item is substitutable if it's already on disk); it also knows about their
-prerequisites, unless they are themselves substitutable.
+
+The returned procedure knows about all substitutes for all the derivation
+inputs or derivations listed in INPUTS-OR-DRV, *except* those that are already
+valid (that is, it won't bother checking whether an item is substitutable if
+it's already on disk); it also knows about their prerequisites, unless they
+are themselves substitutable.
 
 Creating a single oracle (thus making a single 'substitutable-path-info' call) 
and
 reusing it is much more efficient than calling 'has-substitutes?' or similar
 repeatedly, because it avoids the costs associated with launching the
 substituter many times."
-  (define valid?
-    (cut valid-path? store <>))
-
   (define valid-input?
     (cut valid-derivation-input? store <>))
 
-  (define (dependencies drv)
-    ;; Skip prerequisite sub-trees of DRV whose root is valid.  This allows us
-    ;; to ask the substituter for just as much as needed, instead of asking it
-    ;; for the whole world, which can be significantly faster when substitute
-    ;; info is not already in cache.
-    ;; Also, skip derivations marked as non-substitutable.
-    (append-map (lambda (input)
+  (define (closure inputs)
+    (let loop ((inputs inputs)
+               (closure '())
+               (visited (set)))
+      (match inputs
+        (()
+         (reverse closure))
+        ((input rest ...)
+         (let ((key (derivation-input-key input)))
+           (cond ((set-contains? visited key)
+                  (loop rest closure visited))
+                 ((valid-input? input)
+                  (loop rest closure (set-insert key visited)))
+                 (else
                   (let ((drv (derivation-input-derivation input)))
-                    (if (substitutable-derivation? drv)
-                        (derivation-input-output-paths input)
-                        '())))
-                (derivation-prerequisites drv valid-input?)))
-
-  (let* ((paths (delete-duplicates
-                 (concatenate
-                  (fold (lambda (drv result)
-                          (let ((self (match (derivation->output-paths drv)
-                                        (((names . paths) ...)
-                                         paths))))
-                            (cond ((eqv? mode (build-mode check))
-                                   (cons (dependencies drv) result))
-                                  ((not (substitutable-derivation? drv))
-                                   (cons (dependencies drv) result))
-                                  ((every valid? self)
-                                   result)
-                                  (else
-                                   (cons* self (dependencies drv) result)))))
-                        '()
-                        drv))))
-         (subst (fold (lambda (subst vhash)
-                        (vhash-cons (substitutable-path subst) subst
-                                    vhash))
-                      vlist-null
-                      (substitutable-path-info store paths))))
+                    (loop (append (derivation-inputs drv) rest)
+                          (if (substitutable-derivation? drv)
+                              (cons input closure)
+                              closure)
+                          (set-insert key visited))))))))))
+
+  (let* ((inputs (closure (map (match-lambda
+                                 ((? derivation-input? input)
+                                  input)
+                                 ((? derivation? drv)
+                                  (derivation-input drv)))
+                               inputs-or-drv)))
+         (items  (append-map derivation-input-output-paths inputs))
+         (subst  (fold (lambda (subst vhash)
+                         (vhash-cons (substitutable-path subst) subst
+                                     vhash))
+                       vlist-null
+                       (substitutable-path-info store items))))
     (lambda (item)
       (match (vhash-assoc item subst)
         (#f #f)
@@ -367,10 +364,7 @@ of SUBSTITUTABLES."
                                 (mode (build-mode normal))
                                 (substitutable-info
                                  (substitution-oracle
-                                  store
-                                  (map derivation-input-derivation
-                                       inputs)
-                                  #:mode mode)))
+                                  store inputs #:mode mode)))
   "Given INPUTS, a list of derivation-inputs, return two values: the list of
 derivation to build, and the list of substitutable items that, together,
 allows INPUTS to be realized.
diff --git a/guix/ui.scm b/guix/ui.scm
index 2ce82ff..7d6ab9a 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -835,8 +835,7 @@ check and report what is prerequisites are available for 
download."
     ;; substituter many times.  This makes a big difference, especially when
     ;; DRV is a long list as is the case with 'guix environment'.
     (if use-substitutes?
-        (substitution-oracle store (map derivation-input-derivation inputs)
-                             #:mode mode)
+        (substitution-oracle store inputs #:mode mode)
         (const #f)))
 
   (let*-values (((build download)