kreyren/guix-kreyren
1
0
Fork 0
Code Issues 1 Pull Requests 1 Releases Activity

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

Browse Source 
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:
Ludovic Courtès 2015-01-10 00:39:59 +01:00
parent 0b6af195fe
commit e9651e39b3
3 changed files with 52 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
guix/derivations.scm
View File

@ -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))

16
guix/ui.scm
View File

@ -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))))
'() '()

3
tests/derivations.scm
View File

@ -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*)