derivations: Add 'substitution-oracle' and use it.

This makes 'guix environment PACKAGE' significantly faster when
substitutes are enabled.  Before that, it would lead to many invocations
of 'guix substitute-binary', one per 'derivation-prerequisites-to-build'
call.  Now, all these are replaced by a single invocation.

* guix/derivations.scm (derivation-output-paths, substitution-oracle):
  New procedures.
  (derivation-prerequisites-to-build): Replace #:use-substitutes? with
  #:substitutable?.  Remove the local 'derivation-output-paths' and
  'substitutable?'.
* guix/ui.scm (show-what-to-build): Add 'substitutable?'.  Pass it to
  'derivation-prerequisites-to-build'.
  [built-or-substitutable?]: Use it instead of 'has-substitutes?'.
* tests/derivations.scm ("derivation-prerequisites-to-build and
  substitutes"): Use #:substitutable? instead of #:use-substitutes?.

1 files changed, 39 insertions, 25 deletions

diff --git a/guix/derivations.scm b/guix/derivations.scm
index 5e96d9fa3c..ec438e833c 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -62,6 +62,7 @@
             fixed-output-derivation?
             offloadable-derivation?
             substitutable-derivation?
+            substitution-oracle
             derivation-hash
 
             read-derivation
@@ -184,39 +185,52 @@ download with a fixed hash (aka. `fetchurl')."
   ;; synonymous, see <http://bugs.gnu.org/18747>.
   offloadable-derivation?)
 
+(define (derivation-output-paths drv sub-drvs)
+  "Return the output paths of outputs SUB-DRVS of DRV."
+  (match drv
+    (($ <derivation> outputs)
+     (map (lambda (sub-drv)
+            (derivation-output-path (assoc-ref outputs sub-drv)))
+          sub-drvs))))
+
+(define* (substitution-oracle store drv)
+  "Return a one-argument procedure that, when passed a store file name,
+returns #t if it's substitutable and #f otherwise.  The returned procedure
+knows about all substitutes for all the derivations listed in DRV and their
+prerequisites.
+
+Creating a single oracle (thus making a single 'substitutable-paths' 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."
+  (let* ((paths (delete-duplicates
+                 (fold (lambda (drv result)
+                         (let ((self (match (derivation->output-paths drv)
+                                       (((names . paths) ...)
+                                        paths)))
+                               (deps (append-map derivation-input-output-paths
+                                                 (derivation-prerequisites
+                                                  drv))))
+                           (append self deps result)))
+                       '()
+                       drv)))
+         (subst (substitutable-paths store paths)))
+    (cut member <> subst)))
+
 (define* (derivation-prerequisites-to-build store drv
                                             #:key
                                             (outputs
                                              (derivation-output-names drv))
-                                            (use-substitutes? #t))
+                                            (substitutable?
+                                             (substitution-oracle store
+                                                                  (list drv))))
   "Return two values: the list of derivation-inputs required to build the
 OUTPUTS of DRV and not already available in STORE, recursively, and the list
-of required store paths that can be substituted.  When USE-SUBSTITUTES? is #f,
-that second value is the empty list."
-  (define (derivation-output-paths drv sub-drvs)
-    (match drv
-      (($ <derivation> outputs)
-       (map (lambda (sub-drv)
-              (derivation-output-path (assoc-ref outputs sub-drv)))
-            sub-drvs))))
-
+of required store paths that can be substituted.  SUBSTITUTABLE? must be a
+one-argument procedure similar to that returned by 'substitution-oracle'."
   (define built?
     (cut valid-path? store <>))
 
-  (define substitutable?
-    ;; Return true if the given path is substitutable.  Call
-    ;; `substitutable-paths' upfront, to benefit from parallelism in the
-    ;; substituter.
-    (if use-substitutes?
-        (let ((s (substitutable-paths store
-                                      (append
-                                       (derivation-output-paths drv outputs)
-                                       (append-map
-                                        derivation-input-output-paths
-                                        (derivation-prerequisites drv))))))
-          (cut member <> s))
-        (const #f)))
-
   (define input-built?
     (compose (cut any built? <>) derivation-input-output-paths))