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?.
This commit is contained in:
parent
0b6af195fe
commit
e9651e39b3
|
@ -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-prerequisites-to-build store drv
|
||||
#:key
|
||||
(outputs
|
||||
(derivation-output-names drv))
|
||||
(use-substitutes? #t))
|
||||
"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)
|
||||
"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))
|
||||
(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. 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))
|
||||
|
||||
|
|
16
guix/ui.scm
16
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))))
|
||||
'() '()
|
||||
|
|
|
@ -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*)
|
||||
|
|
Loading…
Reference in New Issue