aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/derivations.scm64
-rw-r--r--guix/ui.scm16
-rw-r--r--tests/derivations.scm3
3 files changed, 52 insertions, 31 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))
diff --git a/guix/ui.scm b/guix/ui.scm
index c77e04172e..5bd4d1f8c2 100644
--- a/guix/ui.scm
+++ b/guix/ui.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>
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
@@ -299,21 +299,27 @@ error."
derivations listed in DRV. Return #t if there's something to build, #f
otherwise. When USE-SUBSTITUTES?, check and report what is prerequisites are
available for download."
+ (define substitutable?
+ ;; Call 'substitutation-oracle' upfront so we don't end up launching the
+ ;; 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 drv)
+ (const #f)))
+
(define (built-or-substitutable? drv)
(let ((out (derivation->output-path drv)))
;; If DRV has zero outputs, OUT is #f.
(or (not out)
(or (valid-path? store out)
- (and use-substitutes?
- (has-substitutes? store out))))))
+ (substitutable? out)))))
(let*-values (((build download)
(fold2 (lambda (drv build download)
(let-values (((b d)
(derivation-prerequisites-to-build
store drv
- #:use-substitutes?
- use-substitutes?)))
+ #:substitutable? substitutable?)))
(values (append b build)
(append d download))))
'() '()
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 25e6f75657..8e592ab6a1 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -589,7 +589,8 @@
(derivation-prerequisites-to-build store drv))
((build* download*)
(derivation-prerequisites-to-build store drv
- #:use-substitutes? #f)))
+ #:substitutable?
+ (const #f))))
(and (null? build)
(equal? download (list output))
(null? download*)