diff options
Diffstat (limited to 'guix')
| -rw-r--r-- | guix/build-system/cmake.scm | 6 | ||||
| -rw-r--r-- | guix/build-system/gnu.scm | 20 | ||||
| -rw-r--r-- | guix/build-system/perl.scm | 4 | ||||
| -rw-r--r-- | guix/build-system/python.scm | 4 | ||||
| -rw-r--r-- | guix/derivations.scm | 79 | ||||
| -rw-r--r-- | guix/download.scm | 32 | ||||
| -rw-r--r-- | guix/packages.scm | 11 | ||||
| -rw-r--r-- | guix/scripts/build.scm | 23 | ||||
| -rw-r--r-- | guix/scripts/package.scm | 19 | ||||
| -rw-r--r-- | guix/ui.scm | 34 |
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? |