diff options
| author | Mark H Weaver <mhw@netris.org> | 2015-01-11 09:38:49 -0500 |
|---|---|---|
| committer | Mark H Weaver <mhw@netris.org> | 2015-01-11 09:38:49 -0500 |
| commit | 77448857311318fc9cd866afcb85ca98fccdb25b (patch) | |
| tree | efed3a71d1f7b2c2cc292e7e4ba1884c4d26a9e4 /guix/ui.scm | |
| parent | 62c155c0bcbc0d71b1bc35e966193b6e8de03246 (diff) | |
| parent | 0009ed71ad288358cbc7828954b5e1a3f18fd525 (diff) | |
Merge branch 'master' into core-updates
Diffstat (limited to 'guix/ui.scm')
| -rw-r--r-- | guix/ui.scm | 16 |
1 files changed, 11 insertions, 5 deletions
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)))) '() '() |