summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-09-18 17:01:40 +0200
committerLudovic Courtès <ludo@gnu.org>2013-09-18 18:49:53 +0200
commit59688fc4b5cfac3e05610195a47795f5cc15f338 (patch)
treea1f498fc498857e65e5002817760c8721c9caf45 /guix
parent81b66f8567ea2e3ecb0983318d5dedd3b1332e48 (diff)
derivations: 'derivation' and related procedures return a single value.
* guix/derivations.scm (derivation->output-path, derivation->output-paths): New procedures. (derivation-path->output-path): Use 'derivation->output-path'. (derivation-path->output-paths): Use 'derivation->output-paths'. (derivation): Accept 'derivation?' objects as inputs. Return a single value. (build-derivations): New procedure. (compiled-modules): Use 'derivation->output-paths'. (build-expression->derivation)[source-path]: Add case for when the input matches 'derivation?'. [prologue]: Accept 'derivation?' objects in INPUTS. [mod-dir, go-dir]: Use 'derivation->output-path'. * guix/download.scm (url-fetch): Adjust to the single-value return. * guix/packages.scm (package-output): Use 'derivation->output-path'. * guix/scripts/build.scm (guix-build): When the argument is 'derivation-path?', pass it through 'read-derivation'. Use 'derivation-file-name' to print out the .drv file names, and to register them. Use 'derivation->output-path' instead of 'derivation-path->output-path'. * guix/scripts/package.scm (roll-back): Adjust to the single-value return. (guix-package): Use 'derivation->output-path'. * guix/ui.scm (show-what-to-build): Adjust to deal with 'derivation?' objects instead of .drv file names. * gnu/system/grub.scm (grub-configuration-file): Use 'derivation->output-path' instead of 'derivation-path->output-path'. * gnu/system/vm.scm (qemu-image, system-qemu-image): Likewise. * tests/builders.scm, tests/derivations.scm, tests/packages.scm, tests/store.scm, tests/union.scm: Adjust to the new calling convention. * doc/guix.texi (Defining Packages, The Store, Derivations): Adjust accordingly.
Diffstat (limited to 'guix')
-rw-r--r--guix/build-system/cmake.scm6
-rw-r--r--guix/build-system/gnu.scm20
-rw-r--r--guix/build-system/perl.scm4
-rw-r--r--guix/build-system/python.scm4
-rw-r--r--guix/derivations.scm79
-rw-r--r--guix/download.scm32
-rw-r--r--guix/packages.scm11
-rw-r--r--guix/scripts/build.scm23
-rw-r--r--guix/scripts/package.scm19
-rw-r--r--guix/ui.scm34
10 files changed, 128 insertions, 104 deletions
diff --git a/guix/build-system/cmake.scm b/guix/build-system/cmake.scm
index 76a9a3befe..9461b19a2e 100644
--- a/guix/build-system/cmake.scm
+++ b/guix/build-system/cmake.scm
@@ -72,9 +72,9 @@ provides a 'CMakeLists.txt' file as its build system."
(define builder
`(begin
(use-modules ,@modules)
- (cmake-build #:source ,(if (and source (derivation-path? source))
- (derivation-path->output-path source)
- source)
+ (cmake-build #:source ,(if (derivation? source)
+ (derivation->output-path source)
+ source)
#:system ,system
#:outputs %outputs
#:inputs %build-inputs
diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm
index 03d56edadf..5f13f8ee29 100644
--- a/guix/build-system/gnu.scm
+++ b/guix/build-system/gnu.scm
@@ -291,8 +291,8 @@ which could lead to gratuitous input divergence."
(define builder
`(begin
(use-modules ,@modules)
- (gnu-build #:source ,(if (and source (derivation-path? source))
- (derivation-path->output-path source)
+ (gnu-build #:source ,(if (derivation? source)
+ (derivation->output-path source)
source)
#:system ,system
#:outputs %outputs
@@ -319,8 +319,8 @@ which could lead to gratuitous input divergence."
(match guile
((? package?)
(package-derivation store guile system))
- ((and (? string?) (? derivation-path?))
- guile)
+ ;; ((and (? string?) (? derivation-path?))
+ ;; guile)
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages base)))
(guile (module-ref distro 'guile-final)))
@@ -438,6 +438,8 @@ platform."
(let ()
(define %build-host-inputs
',(map (match-lambda
+ ((name (? derivation? drv) sub ...)
+ `(,name . ,(apply derivation->output-path drv sub)))
((name (? derivation-path? drv-path) sub ...)
`(,name . ,(apply derivation-path->output-path
drv-path sub)))
@@ -447,6 +449,8 @@ platform."
(define %build-target-inputs
',(map (match-lambda
+ ((name (? derivation? drv) sub ...)
+ `(,name . ,(apply derivation->output-path drv sub)))
((name (? derivation-path? drv-path) sub ...)
`(,name . ,(apply derivation-path->output-path
drv-path sub)))
@@ -454,8 +458,8 @@ platform."
`(,name . ,path)))
(append (or implicit-target-inputs '()) inputs)))
- (gnu-build #:source ,(if (and source (derivation-path? source))
- (derivation-path->output-path source)
+ (gnu-build #:source ,(if (derivation? source)
+ (derivation->output-path source)
source)
#:system ,system
#:target ,target
@@ -488,8 +492,8 @@ platform."
(match guile
((? package?)
(package-derivation store guile system))
- ((and (? string?) (? derivation-path?))
- guile)
+ ;; ((and (? string?) (? derivation-path?))
+ ;; guile)
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages base)))
(guile (module-ref distro 'guile-final)))
diff --git a/guix/build-system/perl.scm b/guix/build-system/perl.scm
index 1ff9fd2674..6661689efb 100644
--- a/guix/build-system/perl.scm
+++ b/guix/build-system/perl.scm
@@ -62,8 +62,8 @@ provides a `Makefile.PL' file as its build system."
`(begin
(use-modules ,@modules)
(perl-build #:name ,name
- #:source ,(if (and source (derivation-path? source))
- (derivation-path->output-path source)
+ #:source ,(if (derivation? source)
+ (derivation->output-path source)
source)
#:search-paths ',(map search-path-specification->sexp
(append perl-search-paths
diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm
index 03e587ba01..cf7ca7d3e1 100644
--- a/guix/build-system/python.scm
+++ b/guix/build-system/python.scm
@@ -120,8 +120,8 @@ provides a 'setup.py' file as its build system."
`(begin
(use-modules ,@modules)
(python-build #:name ,name
- #:source ,(if (and source (derivation-path? source))
- (derivation-path->output-path source)
+ #:source ,(if (derivation? source)
+ (derivation->output-path source)
source)
#:configure-flags ,configure-flags
#:system ,system
diff --git a/guix/derivations.scm b/guix/derivations.scm
index 43ea328b0e..433a8f145e 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -58,6 +58,8 @@
read-derivation
write-derivation
+ derivation->output-path
+ derivation->output-paths
derivation-path->output-path
derivation-path->output-paths
derivation
@@ -66,7 +68,8 @@
imported-modules
compiled-modules
build-expression->derivation
- imported-files))
+ imported-files)
+ #:replace (build-derivations))
;;;
;;; Nix derivations, as implemented in Nix's `derivations.cc'.
@@ -420,25 +423,30 @@ that form."
port)
(display ")" port))))
+(define* (derivation->output-path drv #:optional (output "out"))
+ "Return the store path of its output OUTPUT."
+ (let ((outputs (derivation-outputs drv)))
+ (and=> (assoc-ref outputs output) derivation-output-path)))
+
+(define (derivation->output-paths drv)
+ "Return the list of name/path pairs of the outputs of DRV."
+ (map (match-lambda
+ ((name . output)
+ (cons name (derivation-output-path output))))
+ (derivation-outputs drv)))
+
(define derivation-path->output-path
;; This procedure is called frequently, so memoize it.
(memoize
(lambda* (path #:optional (output "out"))
"Read the derivation from PATH (`/nix/store/xxx.drv'), and return the store
path of its output OUTPUT."
- (let* ((drv (call-with-input-file path read-derivation))
- (outputs (derivation-outputs drv)))
- (and=> (assoc-ref outputs output) derivation-output-path)))))
+ (derivation->output-path (call-with-input-file path read-derivation)))))
(define (derivation-path->output-paths path)
"Read the derivation from PATH (`/nix/store/xxx.drv'), and return the
list of name/path pairs of its outputs."
- (let* ((drv (call-with-input-file path read-derivation))
- (outputs (derivation-outputs drv)))
- (map (match-lambda
- ((name . output)
- (cons name (derivation-output-path output))))
- outputs)))
+ (derivation->output-paths (call-with-input-file path read-derivation)))
;;;
@@ -522,10 +530,10 @@ the derivation called NAME with hash HASH."
(inputs '()) (outputs '("out"))
hash hash-algo hash-mode
references-graphs)
- "Build a derivation with the given arguments. Return the resulting
-store path and <derivation> object. When HASH, HASH-ALGO, and HASH-MODE
-are given, a fixed-output derivation is created---i.e., one whose result is
-known in advance, such as a file download.
+ "Build a derivation with the given arguments, and return the resulting
+<derivation> object. When HASH, HASH-ALGO, and HASH-MODE are given, a
+fixed-output derivation is created---i.e., one whose result is known in
+advance, such as a file download.
When REFERENCES-GRAPHS is true, it must be a list of file name/store path
pairs. In that case, the reference graph of each store path is exported in
@@ -610,6 +618,12 @@ the build environment in the corresponding file, in a simple text format."
(make-derivation-output "" hash-algo hash)))
outputs))
(inputs (map (match-lambda
+ (((? derivation? drv))
+ (make-derivation-input (derivation-file-name drv)
+ '("out")))
+ (((? derivation? drv) sub-drvs ...)
+ (make-derivation-input (derivation-file-name drv)
+ sub-drvs))
(((? direct-store-path? input))
(make-derivation-input input '("out")))
(((? direct-store-path? input) sub-drvs ...)
@@ -638,7 +652,21 @@ the build environment in the corresponding file, in a simple text format."
(cut write-derivation drv <>))
(map derivation-input-path
inputs))))
- (values file (set-file-name drv file)))))
+ (set-file-name drv file))))
+
+
+;;;
+;;; Store compatibility layer.
+;;;
+
+(define (build-derivations store derivations)
+ "Build DERIVATIONS, a list of <derivation> objects or .drv file names."
+ (let ((build (@ (guix store) build-derivations)))
+ (build store (map (match-lambda
+ ((? string? file) file)
+ ((and drv ($ <derivation>))
+ (derivation-file-name drv)))
+ derivations))))
;;;
@@ -730,7 +758,7 @@ they can refer to each other."
#:system system
#:guile guile
#:module-path module-path))
- (module-dir (derivation-path->output-path module-drv))
+ (module-dir (derivation->output-path module-drv))
(files (map (lambda (m)
(let ((f (string-join (map symbol->string m)
"/")))
@@ -794,7 +822,7 @@ See the `derivation' procedure for the meaning of REFERENCES-GRAPHS."
(or guile-for-build (%guile-for-build)))
(define guile
- (string-append (derivation-path->output-path guile-drv)
+ (string-append (derivation->output-path guile-drv)
"/bin/guile"))
(define module-form?
@@ -806,6 +834,8 @@ See the `derivation' procedure for the meaning of REFERENCES-GRAPHS."
;; When passed an input that is a source, return its path; otherwise
;; return #f.
(match-lambda
+ ((_ (? derivation?) _ ...)
+ #f)
((_ path _ ...)
(and (not (derivation-path? path))
path))))
@@ -830,10 +860,13 @@ See the `derivation' procedure for the meaning of REFERENCES-GRAPHS."
(() "out")
((x) x))))
(cons name
- (if (derivation-path? drv)
- (derivation-path->output-path drv
- sub)
- drv)))))
+ (cond
+ ((derivation? drv)
+ (derivation->output-path drv sub))
+ ((derivation-path? drv)
+ (derivation-path->output-path drv
+ sub))
+ (else drv))))))
inputs))
,@(if (null? modules)
@@ -878,13 +911,13 @@ See the `derivation' procedure for the meaning of REFERENCES-GRAPHS."
#:guile guile-drv
#:system system)))
(mod-dir (and mod-drv
- (derivation-path->output-path mod-drv)))
+ (derivation->output-path mod-drv)))
(go-drv (and (pair? modules)
(compiled-modules store modules
#:guile guile-drv
#:system system)))
(go-dir (and go-drv
- (derivation-path->output-path go-drv))))
+ (derivation->output-path go-drv))))
(derivation store name guile
`("--no-auto-compile"
,@(if mod-dir `("-L" ,mod-dir) '())
diff --git a/guix/download.scm b/guix/download.scm
index fa76615ef2..8b1d15f273 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -25,7 +25,6 @@
#:use-module ((guix build download) #:renamer (symbol-prefix-proc 'build:))
#:use-module (guix utils)
#:use-module (srfi srfi-1)
- #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:export (%mirrors
url-fetch
@@ -212,27 +211,22 @@ must be a list of symbol/URL-list pairs."
((url ...)
(any https? url)))))
- (let*-values (((gnutls-drv-path gnutls-drv)
- (if need-gnutls?
- (gnutls-derivation store system)
- (values #f #f)))
- ((gnutls)
- (and gnutls-drv
- (derivation-output-path
- (assoc-ref (derivation-outputs gnutls-drv)
- "out"))))
- ((env-vars)
- (if gnutls
- (let ((dir (string-append gnutls "/share/guile/site")))
- ;; XXX: `GUILE_LOAD_COMPILED_PATH' is overridden
- ;; by `build-expression->derivation', so we can't
- ;; set it here.
- `(("GUILE_LOAD_PATH" . ,dir)))
- '())))
+ (let* ((gnutls-drv (if need-gnutls?
+ (gnutls-derivation store system)
+ (values #f #f)))
+ (gnutls (and gnutls-drv
+ (derivation->output-path gnutls-drv "out")))
+ (env-vars (if gnutls
+ (let ((dir (string-append gnutls "/share/guile/site")))
+ ;; XXX: `GUILE_LOAD_COMPILED_PATH' is overridden
+ ;; by `build-expression->derivation', so we can't
+ ;; set it here.
+ `(("GUILE_LOAD_PATH" . ,dir)))
+ '())))
(build-expression->derivation store (or name file-name) system
builder
(if gnutls-drv
- `(("gnutls" ,gnutls-drv-path))
+ `(("gnutls" ,gnutls-drv))
'())
#:hash-algo hash-algo
#:hash hash
diff --git a/guix/packages.scm b/guix/packages.scm
index f63727dd32..efec414675 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -26,7 +26,6 @@
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9 gnu)
- #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
@@ -370,8 +369,8 @@ information in exceptions."
(define* (package-derivation store package
#:optional (system (%current-system)))
- "Return the derivation path and corresponding <derivation> object of
-PACKAGE for SYSTEM."
+ "Return the <derivation> object of PACKAGE for SYSTEM."
+
;; Compute the derivation and cache the result. Caching is important
;; because some derivations, such as the implicit inputs of the GNU build
;; system, will be queried many, many times in a row.
@@ -468,7 +467,5 @@ system identifying string)."
"Return the output path of PACKAGE's OUTPUT for SYSTEM---where OUTPUT is the
symbolic output name, such as \"out\". Note that this procedure calls
`package-derivation', which is costly."
- (let-values (((_ drv)
- (package-derivation store package system)))
- (derivation-output-path
- (assoc-ref (derivation-outputs drv) output))))
+ (let ((drv (package-derivation store package system)))
+ (derivation->output-path drv output)))
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 26cd28215e..a06755dc7a 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -250,7 +250,7 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
(derivations-from-package-expressions
str package->derivation sys src?))
(('argument . (? derivation-path? drv))
- drv)
+ (call-with-input-file drv read-derivation))
(('argument . (? string? x))
(let ((p (find-package x)))
(if src?
@@ -280,24 +280,23 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
(if (assoc-ref opts 'derivations-only?)
(begin
- (format #t "~{~a~%~}" drv)
+ (format #t "~{~a~%~}" (map derivation-file-name drv))
(for-each (cut register-root <> <>)
- (map list drv) roots))
+ (map (compose list derivation-file-name) drv)
+ roots))
(or (assoc-ref opts 'dry-run?)
(and (build-derivations (%store) drv)
(for-each (lambda (d)
- (let ((drv (call-with-input-file d
- read-derivation)))
- (format #t "~{~a~%~}"
- (map (match-lambda
- ((out-name . out)
- (derivation-path->output-path
- d out-name)))
- (derivation-outputs drv)))))
+ (format #t "~{~a~%~}"
+ (map (match-lambda
+ ((out-name . out)
+ (derivation->output-path
+ d out-name)))
+ (derivation-outputs d))))
drv)
(for-each (cut register-root <> <>)
(map (lambda (drv)
(map cdr
- (derivation-path->output-paths drv)))
+ (derivation->output-paths drv)))
drv)
roots)))))))))
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 1393ca3180..862b82612a 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -234,12 +234,9 @@ all of PACKAGES, a list of name/version/output/path/deps tuples."
(_ "nothing to do: already at the empty profile~%")))
((or (zero? previous-number) ; going to emptiness
(not (file-exists? previous-generation)))
- (let*-values (((drv-path drv)
- (profile-derivation (%store) '()))
- ((prof)
- (derivation-output-path
- (assoc-ref (derivation-outputs drv) "out"))))
- (when (not (build-derivations (%store) (list drv-path)))
+ (let* ((drv (profile-derivation (%store) '()))
+ (prof (derivation->output-path drv "out")))
+ (when (not (build-derivations (%store) (list drv)))
(leave (_ "failed to build the empty profile~%")))
(switch-symlinks previous-generation prof)
@@ -558,7 +555,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(define (guile-missing?)
;; Return #t if %GUILE-FOR-BUILD is not available yet.
- (let ((out (derivation-path->output-path (%guile-for-build))))
+ (let ((out (derivation->output-path (%guile-for-build))))
(not (valid-path? (%store) out))))
(define newest-available-packages
@@ -617,7 +614,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(case (version-compare candidate-version current-version)
((>) #t)
((<) #f)
- ((=) (let ((candidate-path (derivation-path->output-path
+ ((=) (let ((candidate-path (derivation->output-path
(package-derivation (%store) pkg))))
(not (string=? current-path candidate-path))))))
(#f #f)))
@@ -808,7 +805,7 @@ more information.~%"))
(match tuple
((name version sub-drv _ (deps ...))
(let ((output-path
- (derivation-path->output-path
+ (derivation->output-path
drv sub-drv)))
`(,name ,version ,sub-drv ,output-path
,(canonicalize-deps deps))))))
@@ -841,11 +838,11 @@ more information.~%"))
(or dry-run?
(and (build-derivations (%store) drv)
(let* ((prof-drv (profile-derivation (%store) packages))
- (prof (derivation-path->output-path prof-drv))
+ (prof (derivation->output-path prof-drv))
(old-drv (profile-derivation
(%store) (manifest-packages
(profile-manifest profile))))
- (old-prof (derivation-path->output-path old-drv))
+ (old-prof (derivation->output-path old-drv))
(number (generation-number profile))
;; Always use NUMBER + 1 for the new profile,
diff --git a/guix/ui.scm b/guix/ui.scm
index 720d01be02..293730308e 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -210,27 +210,27 @@ 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."
(let*-values (((build download)
- (fold2 (lambda (drv-path build download)
- (let ((drv (call-with-input-file drv-path
- read-derivation)))
- (let-values (((b d)
- (derivation-prerequisites-to-build
- store drv
- #:use-substitutes?
- use-substitutes?)))
- (values (append b build)
- (append d download)))))
+ (fold2 (lambda (drv build download)
+ (let-values (((b d)
+ (derivation-prerequisites-to-build
+ store drv
+ #:use-substitutes?
+ use-substitutes?)))
+ (values (append b build)
+ (append d download))))
'() '()
drv))
((build) ; add the DRV themselves
(delete-duplicates
- (append (remove (compose (lambda (out)
- (or (valid-path? store out)
- (and use-substitutes?
- (has-substitutes? store
- out))))
- derivation-path->output-path)
- drv)
+ (append (map derivation-file-name
+ (remove (lambda (drv)
+ (let ((out (derivation->output-path
+ drv)))
+ (or (valid-path? store out)
+ (and use-substitutes?
+ (has-substitutes? store
+ out)))))
+ drv))
(map derivation-input-path build))))
((download) ; add the references of DOWNLOAD
(if use-substitutes?