From e9651e39b315035eb9e87888155f8d6e33ef0567 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 10 Jan 2015 00:39:59 +0100 Subject: 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?. --- guix/derivations.scm | 64 ++++++++++++++++++++++++++++++++-------------------- guix/ui.scm | 16 +++++++++---- 2 files changed, 50 insertions(+), 30 deletions(-) (limited to 'guix') 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 +;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès ;;; ;;; 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 . offloadable-derivation?) +(define (derivation-output-paths drv sub-drvs) + "Return the output paths of outputs SUB-DRVS of DRV." + (match drv + (($ 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 - (($ 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 +;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès ;;; Copyright © 2013 Mark H Weaver ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2014 Alex Kost @@ -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)))) '() '() -- cgit v1.2.3