* guix/build-system.scm (<build-system>)[build, cross-build]: Remove.
[lower]: New field.
(<bag>): New record type.
(make-bag): New procedure.
* guix/packages.scm (bag-transitive-inputs, bag-transitive-build-inputs,
bag-transitive-host-inputs, bag-transitive-target-inputs,
package->bag): New procedures.
(package-derivation): Use it; use the bag, apply its build procedure,
etc.
(package-cross-derivation): Likewise.
* gnu/packages/bootstrap.scm (raw-build, make-raw-bag): New procedure.
(%bootstrap-guile): Use them.
* guix/build-system/trivial.scm (lower): New procedure.
(trivial-build, trivial-cross-build): Remove 'source' parameter. Pass
INPUTS as is.
(trivial-build-system): Adjust accordingly.
* guix/build-system/gnu.scm (%store, inputs-search-paths,
standard-search-paths, expand-inputs, standard-inputs): Remove.
(gnu-lower): New procedure.
(gnu-build): Remove 'source' and #:implicit-inputs? parameters.
Remove 'implicit-inputs' and 'implicit-search-paths' variables. Get
the source from INPUT-DRVS.
(gnu-cross-build): Likewise.
(standard-cross-packages): Remove call to 'standard-packages'.
(standard-cross-inputs, standard-cross-search-paths): Remove.
(gnu-build-system): Remove 'build' and 'cross-build'; add 'lower'.
* guix/build-system/cmake.scm (lower): New procedure.
(cmake-build): Remove 'source' and #:cmake parameters. Use INPUTS and
SEARCH-PATHS as is. Get the source from INPUTS.
* guix/build-system/perl.scm: Likewise.
* guix/build-system/python.scm: Likewise.
* guix/build-system/ruby.scm: Likewise.
* gnu/packages/cross-base.scm (cross-gcc): Change "cross-linux-headers"
to "linux-headers".
(cross-libc)[xlinux-headers]: Pass #:implicit-cross-inputs? #f.
Likewise. In 'propagated-inputs', change "cross-linux-headers" to
"linux-headers".
* guix/git-download.scm (git-fetch): Use 'standard-packages' instead of
'standard-inputs'.
* tests/builders.scm ("gnu-build-system"): Remove use of
'build-system-builder'.
("gnu-build"): Remove 'source' and #:implicit-inputs? arguments to
'gnu-build'.
* tests/packages.scm ("search paths"): Adjust to new build system API.
("package-cross-derivation, no cross builder"): Likewise.
* doc/guix.texi (Build Systems): Add paragraph on bags.
(eval . (put 'with-directory-excursion 'scheme-indent-function 1))
(eval . (put 'package 'scheme-indent-function 0))
(eval . (put 'origin 'scheme-indent-function 0))
+ (eval . (put 'build-system 'scheme-indent-function 0))
+ (eval . (put 'bag 'scheme-indent-function 0))
(eval . (put 'operating-system 'scheme-indent-function 0))
(eval . (put 'file-system 'scheme-indent-function 0))
(eval . (put 'manifest-entry 'scheme-indent-function 0))
create and manipulate them is provided by the @code{(guix build-system)}
module, and actual build systems are exported by specific modules.
+Under the hood, build systems first compile package objects to
+@dfn{bags}. A @dfn{bag} is like a package, but with less
+ornamentation---in other words, a bag is a lower-level representation of
+a package, which includes all the inputs of that package, including some
+that were implicitly added by the build system. This intermediate
+representation is then compiled to a derivation (@pxref{Derivations}).
+
Build systems accept an optional list of @dfn{arguments}. In package
definitions, these are passed @i{via} the @code{arguments} field
(@pxref{Defining Packages}). They are typically keyword arguments
;;; Bootstrap packages.
;;;
+(define* (raw-build store name inputs
+ #:key outputs system search-paths
+ #:allow-other-keys)
+ (define (->store file)
+ (add-to-store store file #t "sha256"
+ (or (search-bootstrap-binary file
+ system)
+ (error "bootstrap binary not found"
+ file system))))
+
+ (let* ((tar (->store "tar"))
+ (xz (->store "xz"))
+ (mkdir (->store "mkdir"))
+ (bash (->store "bash"))
+ (guile (->store "guile-2.0.9.tar.xz"))
+ (builder
+ (add-text-to-store store
+ "build-bootstrap-guile.sh"
+ (format #f "
+echo \"unpacking bootstrap Guile to '$out'...\"
+~a $out
+cd $out
+~a -dc < ~a | ~a xv
+
+# Sanity check.
+$out/bin/guile --version~%"
+ mkdir xz guile tar)
+ (list mkdir xz guile tar))))
+ (derivation store name
+ bash `(,builder)
+ #:system system
+ #:inputs `((,bash) (,builder)))))
+
+(define* (make-raw-bag name
+ #:key source inputs native-inputs outputs target)
+ (bag
+ (name name)
+ (build-inputs inputs)
+ (build raw-build)))
+
(define %bootstrap-guile
;; The Guile used to run the build scripts of the initial derivations.
;; It is just unpacked from a tarball containing a pre-built binary.
;; XXX: Would need libc's `libnss_files2.so' for proper `getaddrinfo'
;; support (for /etc/services).
(let ((raw (build-system
- (name "raw")
- (description "Raw build system with direct store access")
- (build (lambda* (store name source inputs
- #:key outputs system search-paths)
- (define (->store file)
- (add-to-store store file #t "sha256"
- (or (search-bootstrap-binary file
- system)
- (error "bootstrap binary not found"
- file system))))
-
- (let* ((tar (->store "tar"))
- (xz (->store "xz"))
- (mkdir (->store "mkdir"))
- (bash (->store "bash"))
- (guile (->store "guile-2.0.9.tar.xz"))
- (builder
- (add-text-to-store store
- "build-bootstrap-guile.sh"
- (format #f "
-echo \"unpacking bootstrap Guile to '$out'...\"
-~a $out
-cd $out
-~a -dc < ~a | ~a xv
-
-# Sanity check.
-$out/bin/guile --version~%"
- mkdir xz guile tar)
- (list mkdir xz guile tar))))
- (derivation store name
- bash `(,builder)
- #:system system
- #:inputs `((,bash) (,builder)))))))))
+ (name 'raw)
+ (description "Raw build system with direct store access")
+ (lower make-raw-bag))))
(package
(name "guile-bootstrap")
(version "2.0")
;; them from CPATH.
(let ((libc (assoc-ref inputs "libc"))
(linux (assoc-ref inputs
- "libc/cross-linux-headers")))
+ "libc/linux-headers")))
(define (cross? x)
;; Return #t if X is a cross-libc or cross Linux.
(or (string-prefix? libc x)
(name (string-append (package-name linux-libre-headers)
"-cross-" target))
(arguments
- (substitute-keyword-arguments (package-arguments linux-libre-headers)
+ (substitute-keyword-arguments
+ `(#:implicit-cross-inputs? #f
+ ,@(package-arguments linux-libre-headers))
((#:phases phases)
`(alist-replace
'build
(name (string-append "glibc-cross-" target))
(arguments
(substitute-keyword-arguments
- `(#:strip-binaries? #f ; disable stripping (see above)
+ `(;; Disable stripping (see above.)
+ #:strip-binaries? #f
+
+ ;; This package is used as a target input, but it should not have
+ ;; the usual cross-compilation inputs since that would include
+ ;; itself.
+ #:implicit-cross-inputs? #f
+
,@(package-arguments glibc))
((#:configure-flags flags)
`(cons ,(string-append "--host=" target)
`(alist-cons-before
'configure 'set-cross-linux-headers-path
(lambda* (#:key inputs #:allow-other-keys)
- (let ((linux (assoc-ref inputs "cross-linux-headers")))
+ (let ((linux (assoc-ref inputs "linux-headers")))
(setenv "CROSS_CPATH"
(string-append linux "/include"))
#t))
,phases))))
- (propagated-inputs `(("cross-linux-headers" ,xlinux-headers)))
+ ;; Shadow the native "linux-headers" because glibc's recipe expect the
+ ;; "linux-headers" input to point to the right thing.
+ (propagated-inputs `(("linux-headers" ,xlinux-headers)))
+
(native-inputs `(("cross-gcc" ,xgcc)
("cross-binutils" ,xbinutils)
,@(package-native-inputs glibc)))))
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
(define-module (guix build-system)
#:use-module (guix records)
+ #:use-module (ice-9 match)
#:export (build-system
build-system?
build-system-name
build-system-description
- build-system-builder
- build-system-cross-builder))
+ build-system-lower
+
+ bag
+ bag?
+ bag-name
+ bag-build-inputs
+ bag-host-inputs
+ bag-target-inputs
+ bag-outputs
+ bag-arguments
+ bag-build
+
+ make-bag))
(define-record-type* <build-system> build-system make-build-system
build-system?
(name build-system-name) ; symbol
(description build-system-description) ; short description
- (build build-system-builder) ; (store system name source inputs)
- (cross-build build-system-cross-builder ; (store system x-system ...)
- (default #f)))
+ (lower build-system-lower)) ; args ... -> bags
+
+;; "Bags" are low-level representations of "packages". Here we use
+;; build/host/target in the sense of the GNU tool chain (info "(autoconf)
+;; Specifying Target Triplets").
+(define-record-type* <bag> bag %make-bag
+ bag?
+ (name bag-name) ;string
+ (build-inputs bag-build-inputs ;list of packages
+ (default '()))
+ (host-inputs bag-host-inputs ;list of packages
+ (default '()))
+
+ ;; "Target inputs" are packages that are built natively, but that are used
+ ;; by target programs in a cross-compilation environment. Thus, they act
+ ;; like 'inputs' as far as search paths are concerned. The only example of
+ ;; that is the cross-libc: it is an input of 'cross-gcc', thus built
+ ;; natively; yet, we want it to be considered as a target input for the
+ ;; purposes of $CPATH, $LIBRARY_PATH, etc.
+ (target-inputs bag-target-inputs
+ (default '()))
+
+ (outputs bag-outputs ;list of strings
+ (default '("out")))
+ (arguments bag-arguments ;list
+ (default '()))
+ (build bag-build)) ;bag -> derivation
+
+(define* (make-bag build-system name
+ #:key source (inputs '()) (native-inputs '())
+ (outputs '()) (arguments '())
+ target)
+ "Ask BUILD-SYSTEM to return a 'bag' for NAME, with the given SOURCE,
+INPUTS, NATIVE-INPUTS, OUTPUTS, and additional ARGUMENTS. If TARGET is not
+#f, it must be a string with the GNU triplet of a cross-compilation target.
+
+This is the mechanism by which a package is \"lowered\" to a bag, which is the
+intermediate representation just above derivations."
+ (match build-system
+ (($ <build-system> _ description lower)
+ (apply lower name
+ #:source source
+ #:inputs inputs
+ #:native-inputs native-inputs
+ #:outputs outputs
+ #:target target
+ arguments))))
(let ((module (resolve-interface '(gnu packages cmake))))
(module-ref module 'cmake)))
-(define* (cmake-build store name source inputs
- #:key (guile #f)
- (outputs '("out")) (configure-flags ''())
- (search-paths '())
- (make-flags ''())
- (cmake (default-cmake))
- (out-of-source? #t)
- (build-type "RelWithDebInfo")
- (tests? #t)
- (test-target "test")
- (parallel-build? #t) (parallel-tests? #f)
- (patch-shebangs? #t)
- (strip-binaries? #t)
- (strip-flags ''("--strip-debug"))
- (strip-directories ''("lib" "lib64" "libexec"
- "bin" "sbin"))
- (phases '(@ (guix build cmake-build-system)
- %standard-phases))
- (system (%current-system))
- (imported-modules '((guix build cmake-build-system)
- (guix build gnu-build-system)
- (guix build utils)))
- (modules '((guix build cmake-build-system)
- (guix build utils))))
+(define* (lower name
+ #:key source inputs native-inputs outputs target
+ (cmake (default-cmake))
+ #:allow-other-keys
+ #:rest arguments)
+ "Return a bag for NAME."
+ (define private-keywords
+ '(#:source #:target #:cmake #:inputs #:native-inputs))
+
+ (and (not target) ;XXX: no cross-compilation
+ (bag
+ (name name)
+ (host-inputs `(,@(if source
+ `(("source" ,source))
+ '())
+ ,@inputs
+
+ ;; Keep the standard inputs of 'gnu-build-system'.
+ ,@(standard-packages)))
+ (build-inputs `(("cmake" ,cmake)
+ ,@native-inputs))
+ (outputs outputs)
+ (build cmake-build)
+ (arguments (strip-keyword-arguments private-keywords arguments)))))
+
+(define* (cmake-build store name inputs
+ #:key (guile #f)
+ (outputs '("out")) (configure-flags ''())
+ (search-paths '())
+ (make-flags ''())
+ (out-of-source? #t)
+ (build-type "RelWithDebInfo")
+ (tests? #t)
+ (test-target "test")
+ (parallel-build? #t) (parallel-tests? #f)
+ (patch-shebangs? #t)
+ (strip-binaries? #t)
+ (strip-flags ''("--strip-debug"))
+ (strip-directories ''("lib" "lib64" "libexec"
+ "bin" "sbin"))
+ (phases '(@ (guix build cmake-build-system)
+ %standard-phases))
+ (system (%current-system))
+ (imported-modules '((guix build cmake-build-system)
+ (guix build gnu-build-system)
+ (guix build utils)))
+ (modules '((guix build cmake-build-system)
+ (guix build utils))))
"Build SOURCE using CMAKE, and with INPUTS. This assumes that SOURCE
provides a 'CMakeLists.txt' file as its build system."
(define builder
`(begin
(use-modules ,@modules)
- (cmake-build #:source ,(if (derivation? source)
- (derivation->output-path source)
- source)
+ (cmake-build #:source ,(match (assoc-ref inputs "source")
+ (((? derivation? source))
+ (derivation->output-path source))
+ ((source)
+ source)
+ (source
+ source))
#:system ,system
#:outputs %outputs
#:inputs %build-inputs
#:search-paths ',(map search-path-specification->sexp
- (append search-paths
- (standard-search-paths)))
+ search-paths)
#:phases ,phases
#:configure-flags ,configure-flags
#:make-flags ,make-flags
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system)))))
- (let ((cmake (package-derivation store cmake system)))
- (build-expression->derivation store name builder
- #:system system
- #:inputs
- `(,@(if source
- `(("source" ,source))
- '())
- ("cmake" ,cmake)
- ,@inputs
-
- ;; Keep the standard inputs of
- ;; `gnu-build-system'.
- ,@(standard-inputs system))
-
- #:modules imported-modules
- #:outputs outputs
- #:guile-for-build guile-for-build)))
+ (build-expression->derivation store name builder
+ #:system system
+ #:inputs inputs
+ #:modules imported-modules
+ #:outputs outputs
+ #:guile-for-build guile-for-build))
(define cmake-build-system
- (build-system (name 'cmake)
- (description "The standard CMake build system")
- (build cmake-build)))
+ (build-system
+ (name 'cmake)
+ (description "The standard CMake build system")
+ (lower lower)))
;;; cmake.scm ends here
#:use-module (guix build-system)
#:use-module (guix packages)
#:use-module (srfi srfi-1)
- #:use-module (srfi srfi-39)
#:use-module (ice-9 match)
#:export (gnu-build
gnu-build-system
- standard-search-paths
- standard-inputs
+ standard-packages
package-with-explicit-inputs
package-with-extra-configure-variable
static-libgcc-package
p))
\f
-(define %store
- ;; Store passed to STANDARD-INPUTS.
- (make-parameter #f))
-
(define (standard-packages)
"Return the list of (NAME PACKAGE OUTPUT) or (NAME PACKAGE) tuples of
standard packages used as implicit inputs of the GNU build system."
(let ((distro (resolve-module '(gnu packages commencement))))
(module-ref distro '%final-inputs)))
-(define* (inputs-search-paths inputs
- #:optional (package->search-paths
- package-native-search-paths))
- "Return the <search-path-specification> objects for INPUTS, using
-PACKAGE->SEARCH-PATHS to extract the search path specifications of a package."
- (append-map (match-lambda
- ((_ (? package? p) _ ...)
- (package->search-paths p))
- (_
- '()))
- inputs))
-
-(define (standard-search-paths)
- "Return the list of <search-path-specification> for the standard (implicit)
-inputs when doing a native build."
- (inputs-search-paths (standard-packages)))
-
-(define (expand-inputs inputs system)
- "Expand INPUTS, which contains <package> objects, so that it contains only
-derivations for SYSTEM. Include propagated inputs in the result."
- (define input-package->derivation
- (match-lambda
- ((name pkg sub-drv ...)
- (cons* name (package-derivation (%store) pkg system) sub-drv))
- ((name (? derivation-path? path) sub-drv ...)
- (cons* name path sub-drv))
- (z
- (error "invalid standard input" z))))
-
- (map input-package->derivation
- (append inputs
- (append-map (match-lambda
- ((name package _ ...)
- (package-transitive-propagated-inputs package)))
- inputs))))
-
-(define standard-inputs
- ;; FIXME: Memoization should be associated with the open store (as for
- ;; 'add-text-to-store'), otherwise we get .drv that may not be valid when
- ;; switching to another store.
- (memoize
- (lambda (system)
- "Return the list of implicit standard inputs used with the GNU Build
-System: GCC, GNU Make, Bash, Coreutils, etc."
- (expand-inputs (standard-packages) system))))
-
-(define* (gnu-build store name source inputs
+(define* (lower name
+ #:key source inputs native-inputs outputs target
+ (implicit-inputs? #t) (implicit-cross-inputs? #t)
+ (strip-binaries? #t)
+ #:allow-other-keys
+ #:rest arguments)
+ "Return a bag for NAME from the given arguments."
+ (define private-keywords
+ `(#:source #:inputs #:native-inputs #:outputs
+ #:implicit-inputs? #:implicit-cross-inputs?
+ ,@(if target '() '(#:target))))
+
+ (bag
+ (name name)
+ (build-inputs `(,@(if source
+ `(("source" ,source))
+ '())
+ ,@native-inputs
+ ,@(if (and target implicit-cross-inputs?)
+ (standard-cross-packages target 'host)
+ '())
+ ,@(if implicit-inputs?
+ (standard-packages)
+ '())))
+ (host-inputs inputs)
+
+ ;; The cross-libc is really a target package, but for bootstrapping
+ ;; reasons, we can't put it in 'host-inputs'. Namely, 'cross-gcc' is a
+ ;; native package, so it would end up using a "native" variant of
+ ;; 'cross-libc' (built with 'gnu-build'), whereas all the other packages
+ ;; would use a target variant (built with 'gnu-cross-build'.)
+ (target-inputs (if (and target implicit-cross-inputs?)
+ (standard-cross-packages target 'target)
+ '()))
+ (outputs (if strip-binaries?
+ outputs
+ (delete "debug" outputs)))
+ (build (if target gnu-cross-build gnu-build))
+ (arguments (strip-keyword-arguments private-keywords arguments))))
+
+(define* (gnu-build store name input-drvs
#:key (guile #f)
(outputs '("out"))
(search-paths '())
"bin" "sbin"))
(phases '%standard-phases)
(system (%current-system))
- (implicit-inputs? #t) ; useful when bootstrapping
(imported-modules %default-modules)
(modules %default-modules)
allowed-references)
ALLOWED-REFERENCES can be either #f, or a list of packages that the outputs
are allowed to refer to."
- (define implicit-inputs
- (and implicit-inputs?
- (parameterize ((%store store))
- (standard-inputs system))))
-
- (define implicit-search-paths
- (if implicit-inputs?
- (standard-search-paths)
- '()))
-
(define canonicalize-reference
(match-lambda
((? package? p)
(define builder
`(begin
(use-modules ,@modules)
- (gnu-build #:source ,(if (derivation? source)
- (derivation->output-path source)
- source)
+ (gnu-build #:source ,(match (assoc-ref input-drvs "source")
+ (((? derivation? source))
+ (derivation->output-path source))
+ ((source)
+ source)
+ (source
+ source))
#:system ,system
#:outputs %outputs
#:inputs %build-inputs
#:search-paths ',(map search-path-specification->sexp
- (append implicit-search-paths
- search-paths))
+ search-paths)
#:phases ,phases
#:configure-flags ,configure-flags
#:make-flags ,make-flags
(build-expression->derivation store name builder
#:system system
- #:inputs
- `(,@(if source
- `(("source" ,source))
- '())
- ,@inputs
- ,@(if implicit-inputs?
- implicit-inputs
- '()))
- #:outputs (if strip-binaries?
- outputs
- (delete "debug" outputs))
+ #:inputs input-drvs
+ #:outputs outputs
#:modules imported-modules
#:allowed-references
(and allowed-references
`(("cross-gcc" ,(gcc target
(binutils target)
(libc target)))
- ("cross-binutils" ,(binutils target))
- ,@(standard-packages)))
+ ("cross-binutils" ,(binutils target))))
((target)
`(("cross-libc" ,(libc target)))))))))
-(define standard-cross-inputs
- (memoize
- (lambda (system target kind)
- "Return the list of implicit standard inputs used with the GNU Build
-System when cross-compiling for TARGET: GCC, GNU Make, Bash, Coreutils, etc."
- (expand-inputs (standard-cross-packages target kind) system))))
-
-(define (standard-cross-search-paths target kind)
- "Return the list of <search-path-specification> for the standard (implicit)
-inputs."
- (inputs-search-paths (append (standard-cross-packages target 'target)
- (standard-cross-packages target 'host))
- (case kind
- ((host) package-native-search-paths)
- ((target) package-search-paths))))
-
-(define* (gnu-cross-build store name target source inputs native-inputs
+(define* (gnu-cross-build store name
#:key
+ target native-drvs target-drvs
(guile #f)
+ source
(outputs '("out"))
(search-paths '())
(native-search-paths '())
"bin" "sbin"))
(phases '%standard-phases)
(system (%current-system))
- (implicit-inputs? #t)
(imported-modules '((guix build gnu-build-system)
(guix build utils)))
(modules '((guix build gnu-build-system)
"Cross-build NAME for TARGET, where TARGET is a GNU triplet. INPUTS are
cross-built inputs, and NATIVE-INPUTS are inputs that run on the build
platform."
-
- (define implicit-host-inputs
- (and implicit-inputs?
- (parameterize ((%store store))
- (standard-cross-inputs system target 'host))))
-
- (define implicit-target-inputs
- (and implicit-inputs?
- (parameterize ((%store store))
- (standard-cross-inputs system target 'target))))
-
- (define implicit-host-search-paths
- (if implicit-inputs?
- (standard-cross-search-paths target 'host)
- '()))
-
- (define implicit-target-search-paths
- (if implicit-inputs?
- (standard-cross-search-paths target 'target)
- '()))
-
(define canonicalize-reference
(match-lambda
((? package? p)
',(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)))
((name path)
`(,name . ,path)))
- (append (or implicit-host-inputs '()) native-inputs)))
+ native-drvs))
(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)))
+ ((name (? package? pkg) sub ...)
+ (let ((drv (package-cross-derivation store pkg
+ target system)))
+ `(,name . ,(apply derivation->output-path drv sub))))
((name path)
`(,name . ,path)))
- (append (or implicit-target-inputs '()) inputs)))
-
- (gnu-build #:source ,(if (derivation? source)
- (derivation->output-path source)
- source)
+ target-drvs))
+
+ (gnu-build #:source ,(match (assoc-ref native-drvs "source")
+ (((? derivation? source))
+ (derivation->output-path source))
+ ((source)
+ source)
+ (source
+ source))
#:system ,system
#:target ,target
#:outputs %outputs
#:inputs %build-target-inputs
#:native-inputs %build-host-inputs
#:search-paths ',(map search-path-specification->sexp
- (append implicit-target-search-paths
- search-paths))
+ search-paths)
#:native-search-paths ',(map
search-path-specification->sexp
- (append implicit-host-search-paths
- native-search-paths))
+ native-search-paths)
#:phases ,phases
#:configure-flags ,configure-flags
#:make-flags ,make-flags
(build-expression->derivation store name builder
#:system system
- #:inputs
- `(,@(if source
- `(("source" ,source))
- '())
- ,@inputs
- ,@(if implicit-inputs?
- implicit-target-inputs
- '())
- ,@native-inputs
- ,@(if implicit-inputs?
- implicit-host-inputs
- '()))
- #:outputs (if strip-binaries?
- outputs
- (delete "debug" outputs))
+ #:inputs (append native-drvs target-drvs)
+ #:outputs outputs
#:modules imported-modules
#:allowed-references
(and allowed-references
#:guile-for-build guile-for-build))
(define gnu-build-system
- (build-system (name 'gnu)
- (description
- "The GNU Build System—i.e., ./configure && make && make install")
- (build gnu-build)
- (cross-build gnu-cross-build)))
+ (build-system
+ (name 'gnu)
+ (description
+ "The GNU Build System—i.e., ./configure && make && make install")
+ (lower lower)))
(let ((module (resolve-interface '(gnu packages perl))))
(module-ref module 'perl)))
-(define* (perl-build store name source inputs
+(define* (lower name
+ #:key source inputs native-inputs outputs target
+ (perl (default-perl))
+ #:allow-other-keys
+ #:rest arguments)
+ "Return a bag for NAME."
+ (define private-keywords
+ '(#:source #:target #:perl #:inputs #:native-inputs))
+
+ (and (not target) ;XXX: no cross-compilation
+ (bag
+ (name name)
+ (host-inputs `(,@(if source
+ `(("source" ,source))
+ '())
+ ,@inputs
+
+ ;; Keep the standard inputs of 'gnu-build-system'.
+ ,@(standard-packages)))
+ (build-inputs `(("perl" ,perl)
+ ,@native-inputs))
+ (outputs outputs)
+ (build perl-build)
+ (arguments (strip-keyword-arguments private-keywords arguments)))))
+
+(define* (perl-build store name inputs
#:key
- (perl (default-perl))
(search-paths '())
(tests? #t)
(parallel-build? #t)
(guix build utils))))
"Build SOURCE using PERL, and with INPUTS. This assumes that SOURCE
provides a `Makefile.PL' file as its build system."
- (define perl-search-paths
- (append (package-native-search-paths perl)
- (standard-search-paths)))
-
(define builder
`(begin
(use-modules ,@modules)
(perl-build #:name ,name
- #:source ,(if (derivation? source)
- (derivation->output-path source)
- source)
+ #:source ,(match (assoc-ref inputs "source")
+ (((? derivation? source))
+ (derivation->output-path source))
+ ((source)
+ source)
+ (source
+ source))
#:search-paths ',(map search-path-specification->sexp
- (append perl-search-paths
- search-paths))
+ search-paths)
#:make-maker-flags ,make-maker-flags
#:phases ,phases
#:system ,system
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system)))))
- (let ((perl (package-derivation store perl system)))
- (build-expression->derivation store name builder
- #:system system
- #:inputs
- `(,@(if source
- `(("source" ,source))
- '())
- ("perl" ,perl)
- ,@inputs
-
- ;; Keep the standard inputs of
- ;; `gnu-build-system'.
- ,@(standard-inputs system))
-
- #:modules imported-modules
- #:outputs outputs
- #:guile-for-build guile-for-build)))
+ (build-expression->derivation store name builder
+ #:system system
+ #:inputs inputs
+ #:modules imported-modules
+ #:outputs outputs
+ #:guile-for-build guile-for-build))
(define perl-build-system
- (build-system (name 'perl)
- (description "The standard Perl build system")
- (build perl-build)))
+ (build-system
+ (name 'perl)
+ (description "The standard Perl build system")
+ (lower lower)))
;;; perl.scm ends here
(define package-with-python2
(cut package-with-explicit-python <> (default-python2) "python-" "python2-"))
-(define* (python-build store name source inputs
+(define* (lower name
+ #:key source inputs native-inputs outputs target
+ (python (default-python))
+ #:allow-other-keys
+ #:rest arguments)
+ "Return a bag for NAME."
+ (define private-keywords
+ '(#:source #:target #:python #:inputs #:native-inputs))
+
+ (and (not target) ;XXX: no cross-compilation
+ (bag
+ (name name)
+ (host-inputs `(,@(if source
+ `(("source" ,source))
+ '())
+ ,@inputs
+
+ ;; Keep the standard inputs of 'gnu-build-system'.
+ ,@(standard-packages)))
+ (build-inputs `(("python" ,python)
+ ,@native-inputs))
+ (outputs outputs)
+ (build python-build)
+ (arguments (strip-keyword-arguments private-keywords arguments)))))
+
+(define* (python-build store name inputs
#:key
- (python (default-python))
(tests? #t)
(test-target "test")
(configure-flags ''())
(guix build utils))))
"Build SOURCE using PYTHON, and with INPUTS. This assumes that SOURCE
provides a 'setup.py' file as its build system."
-
- (define python-search-paths
- (append (package-native-search-paths python)
- (standard-search-paths)))
-
(define builder
`(begin
(use-modules ,@modules)
(python-build #:name ,name
- #:source ,(if (derivation? source)
- (derivation->output-path source)
- source)
+ #:source ,(match (assoc-ref inputs "source")
+ (((? derivation? source))
+ (derivation->output-path source))
+ ((source)
+ source)
+ (source
+ source))
#:configure-flags ,configure-flags
#:system ,system
#:test-target ,test-target
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
- (append python-search-paths
- search-paths))
+ search-paths)
#:inputs %build-inputs)))
(define guile-for-build
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system)))))
- (let ((python (package-derivation store python system)))
- (build-expression->derivation store name builder
- #:inputs
- `(,@(if source
- `(("source" ,source))
- '())
- ("python" ,python)
- ,@inputs
-
- ;; Keep the standard inputs of
- ;; 'gnu-build-system'.
- ,@(standard-inputs system))
-
- #:system system
- #:modules imported-modules
- #:outputs outputs
- #:guile-for-build guile-for-build)))
+ (build-expression->derivation store name builder
+ #:inputs inputs
+ #:system system
+ #:modules imported-modules
+ #:outputs outputs
+ #:guile-for-build guile-for-build))
(define python-build-system
- (build-system (name 'python)
- (description "The standard Python build system")
- (build python-build)))
+ (build-system
+ (name 'python)
+ (description "The standard Python build system")
+ (lower lower)))
;;; python.scm ends here
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 David Thompson <davet@gnu.org>
+;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
#:use-module (guix derivations)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
- #:use-module (gnu packages version-control)
#:use-module (ice-9 match)
- #:use-module (srfi srfi-26)
#:export (ruby-build
ruby-build-system))
(let ((ruby (resolve-interface '(gnu packages ruby))))
(module-ref ruby 'ruby)))
-(define* (ruby-build store name source inputs
+(define* (lower name
+ #:key source inputs native-inputs outputs target
+ (ruby (default-ruby))
+ #:allow-other-keys
+ #:rest arguments)
+ "Return a bag for NAME."
+ (define private-keywords
+ '(#:source #:target #:ruby #:inputs #:native-inputs))
+
+ (and (not target) ;XXX: no cross-compilation
+ (bag
+ (name name)
+ (host-inputs `(,@(if source
+ `(("source" ,source))
+ '())
+ ,@inputs
+
+ ;; Keep the standard inputs of 'gnu-build-system'.
+ ,@(standard-packages)))
+ (build-inputs `(("ruby" ,ruby)
+ ,@native-inputs))
+ (outputs outputs)
+ (build ruby-build)
+ (arguments (strip-keyword-arguments private-keywords arguments)))))
+
+(define* (ruby-build store name inputs
#:key
- (ruby (default-ruby))
(test-target "test")
(tests? #t)
(phases '(@ (guix build ruby-build-system)
(modules '((guix build ruby-build-system)
(guix build utils))))
"Build SOURCE using RUBY and INPUTS."
- (define ruby-search-paths
- (append (package-native-search-paths ruby)
- (standard-search-paths)))
-
(define builder
`(begin
(use-modules ,@modules)
(ruby-build #:name ,name
- #:source ,(if (derivation? source)
- (derivation->output-path source)
- source)
+ #:source ,(match (assoc-ref inputs "source")
+ (((? derivation? source))
+ (derivation->output-path source))
+ ((source)
+ source)
+ (source
+ source))
#:system ,system
#:test-target ,test-target
#:tests? ,tests?
#:phases ,phases
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
- (append ruby-search-paths
- search-paths))
+ search-paths)
#:inputs %build-inputs)))
(define guile-for-build
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system)))))
- (let ((ruby (package-derivation store ruby system))
- (git (package-derivation store git system)))
- (build-expression->derivation store name builder
- #:inputs
- `(,@(if source
- `(("source" ,source))
- '())
- ("ruby" ,ruby)
- ,@inputs
- ;; Keep the standard inputs of
- ;; 'gnu-build-system'.
- ,@(standard-inputs system))
- #:system system
- #:modules imported-modules
- #:outputs outputs
- #:guile-for-build guile-for-build)))
+ (build-expression->derivation store name builder
+ #:inputs inputs
+ #:system system
+ #:modules imported-modules
+ #:outputs outputs
+ #:guile-for-build guile-for-build))
(define ruby-build-system
(build-system
- (name 'ruby)
- (description "The standard Ruby build system")
- (build ruby-build)))
+ (name 'ruby)
+ (description "The standard Ruby build system")
+ (lower lower)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system)))))
-(define* (trivial-build store name source inputs
+(define* (lower name
+ #:key source inputs native-inputs outputs target
+ guile builder modules)
+ "Return a bag for NAME."
+ (bag
+ (name name)
+ (host-inputs `(,@(if source
+ `(("source" ,source))
+ '())
+ ,@inputs))
+ (build-inputs native-inputs)
+ (outputs outputs)
+ (build (if target trivial-cross-build trivial-build))
+ (arguments `(#:guile ,guile
+ #:builder ,builder
+ #:modules ,modules))))
+
+(define* (trivial-build store name inputs
#:key
outputs guile system builder (modules '())
search-paths)
"Run build expression BUILDER, an expression, for SYSTEM. SOURCE is
ignored."
(build-expression->derivation store name builder
- #:inputs (if source
- `(("source" ,source) ,@inputs)
- inputs)
+ #:inputs inputs
#:system system
#:outputs outputs
#:modules modules
#:guile-for-build
(guile-for-build store guile system)))
-(define* (trivial-cross-build store name target source inputs native-inputs
+(define* (trivial-cross-build store name
#:key
+ target native-drvs target-drvs
outputs guile system builder (modules '())
search-paths native-search-paths)
- "Like `trivial-build', but in a cross-compilation context."
+ "Run build expression BUILDER, an expression, for SYSTEM. SOURCE is
+ignored."
(build-expression->derivation store name builder
+ #:inputs (append native-drvs target-drvs)
#:system system
- #:inputs
- (let ((inputs (append native-inputs inputs)))
- (if source
- `(("source" ,source) ,@inputs)
- inputs))
#:outputs outputs
#:modules modules
#:guile-for-build
(guile-for-build store guile system)))
(define trivial-build-system
- (build-system (name 'trivial)
- (description
- "Trivial build system, to run arbitrary Scheme build expressions")
- (build trivial-build)
- (cross-build trivial-cross-build)))
+ (build-system
+ (name 'trivial)
+ (description
+ "Trivial build system, to run arbitrary Scheme build expressions")
+ (lower lower)))
#:use-module (guix monads)
#:use-module (guix records)
#:use-module (guix packages)
- #:autoload (guix build-system gnu) (standard-inputs)
+ #:autoload (guix build-system gnu) (standard-packages)
#:use-module (ice-9 match)
#:export (git-reference
git-reference?
;; When doing 'git clone --recursive', we need sed, grep, etc. to be
;; available so that 'git submodule' works.
(if (git-reference-recursive? ref)
- (standard-inputs (%current-system))
+ (standard-packages)
'()))
(define build
package-input-error?
package-error-invalid-input
&package-cross-build-system-error
- package-cross-build-system-error?))
+ package-cross-build-system-error?
+
+ package->bag
+ bag-transitive-inputs
+ bag-transitive-host-inputs
+ bag-transitive-build-inputs
+ bag-transitive-target-inputs))
;;; Commentary:
;;;
recursively."
(transitive-inputs (package-propagated-inputs package)))
+(define (bag-transitive-inputs bag)
+ "Same as 'package-transitive-inputs', but applied to a bag."
+ (transitive-inputs (append (bag-build-inputs bag)
+ (bag-host-inputs bag)
+ (bag-target-inputs bag))))
+
+(define (bag-transitive-build-inputs bag)
+ "Same as 'package-transitive-native-inputs', but applied to a bag."
+ (transitive-inputs (bag-build-inputs bag)))
+
+(define (bag-transitive-host-inputs bag)
+ "Same as 'package-transitive-target-inputs', but applied to a bag."
+ (transitive-inputs (bag-host-inputs bag)))
+
+(define (bag-transitive-target-inputs bag)
+ "Return the \"target inputs\" of BAG, recursively."
+ (transitive-inputs (bag-target-inputs bag)))
+
\f
;;;
;;; Package derivations.
(package package)
(input x)))))))
+(define* (package->bag package #:optional
+ (system (%current-system))
+ (target (%current-target-system)))
+ "Compile PACKAGE into a bag for SYSTEM, possibly cross-compiled to TARGET,
+and return it."
+ ;; Bind %CURRENT-SYSTEM and %CURRENT-TARGET-SYSTEM so that thunked field
+ ;; values can refer to it.
+ (parameterize ((%current-system system)
+ (%current-target-system target))
+ (match package
+ (($ <package> name version source build-system
+ args inputs propagated-inputs native-inputs self-native-input?
+ outputs)
+ (or (make-bag build-system (package-full-name package)
+ #:target target
+ #:source source
+ #:inputs (append (inputs)
+ (propagated-inputs))
+ #:outputs outputs
+ #:native-inputs `(,@(if (and target self-native-input?)
+ `(("self" ,package))
+ '())
+ ,@(native-inputs))
+ #:arguments (args))
+ (raise (if target
+ (condition
+ (&package-cross-build-system-error
+ (package package)))
+ (condition
+ (&package-error
+ (package package))))))))))
+
(define* (package-derivation store package
#:optional (system (%current-system)))
"Return the <derivation> object of PACKAGE for SYSTEM."
;; because some derivations, such as the implicit inputs of the GNU build
;; system, will be queried many, many times in a row.
(cached package system
-
- ;; Bind %CURRENT-SYSTEM so that thunked field values can refer
- ;; to it.
- (parameterize ((%current-system system)
- (%current-target-system #f))
- (match package
- (($ <package> name version source (= build-system-builder builder)
- args inputs propagated-inputs native-inputs self-native-input?
- outputs)
- (let* ((inputs (package-transitive-inputs package))
- (input-drvs (map (cut expand-input
- store package <> system)
- inputs))
- (paths (delete-duplicates
- (append-map (match-lambda
- ((_ (? package? p) _ ...)
- (package-native-search-paths
- p))
- (_ '()))
- inputs))))
-
- (apply builder
- store (package-full-name package)
- (and source
- (package-source-derivation store source system))
- input-drvs
- #:search-paths paths
- #:outputs outputs #:system system
- (args))))))))
+ (let* ((bag (package->bag package system #f))
+ (inputs (bag-transitive-inputs bag))
+ (input-drvs (map (cut expand-input
+ store package <> system)
+ inputs))
+ (paths (delete-duplicates
+ (append-map (match-lambda
+ ((_ (? package? p) _ ...)
+ (package-native-search-paths
+ p))
+ (_ '()))
+ inputs))))
+
+ (apply (bag-build bag)
+ store (bag-name bag)
+ input-drvs
+ #:search-paths paths
+ #:outputs (bag-outputs bag) #:system system
+ (bag-arguments bag)))))
(define* (package-cross-derivation store package target
#:optional (system (%current-system)))
"Cross-build PACKAGE for TARGET (a GNU triplet) from host SYSTEM (a Guix
system identifying string)."
(cached package (cons system target)
-
- ;; Bind %CURRENT-SYSTEM so that thunked field values can refer
- ;; to it.
- (parameterize ((%current-system system)
- (%current-target-system target))
- (match package
- (($ <package> name version source
- (= build-system-cross-builder builder)
- args inputs propagated-inputs native-inputs self-native-input?
- outputs)
- (unless builder
- (raise (condition
- (&package-cross-build-system-error
- (package package)))))
-
- (let* ((inputs (package-transitive-target-inputs package))
- (input-drvs (map (cut expand-input
- store package <>
- system target)
- inputs))
- (host (append (if self-native-input?
- `(("self" ,package))
- '())
- (package-transitive-native-inputs package)))
- (host-drvs (map (cut expand-input
- store package <> system)
- host))
- (all (append host inputs))
- (paths (delete-duplicates
- (append-map (match-lambda
- ((_ (? package? p) _ ...)
- (package-search-paths p))
- (_ '()))
- all)))
- (npaths (delete-duplicates
- (append-map (match-lambda
- ((_ (? package? p) _ ...)
- (package-native-search-paths
- p))
- (_ '()))
- all))))
-
- (apply builder
- store (package-full-name package) target
- (and source
- (package-source-derivation store source system))
- input-drvs host-drvs
- #:search-paths paths
- #:native-search-paths npaths
- #:outputs outputs #:system system
- (args))))))))
+ (let* ((bag (package->bag package system target))
+ (host (bag-transitive-host-inputs bag))
+ (host-drvs (map (cut expand-input
+ store package <>
+ system target)
+ host))
+ (target* (bag-transitive-target-inputs bag))
+ (target-drvs (map (cut expand-input
+ store package <> system)
+ target*))
+ (build (bag-transitive-build-inputs bag))
+ (build-drvs (map (cut expand-input
+ store package <> system)
+ build))
+ (all (append build target* host))
+ (paths (delete-duplicates
+ (append-map (match-lambda
+ ((_ (? package? p) _ ...)
+ (package-search-paths p))
+ (_ '()))
+ all)))
+ (npaths (delete-duplicates
+ (append-map (match-lambda
+ ((_ (? package? p) _ ...)
+ (package-native-search-paths
+ p))
+ (_ '()))
+ all))))
+
+ (apply (bag-build bag)
+ store (bag-name bag)
+ #:native-drvs build-drvs
+ #:target-drvs (append host-drvs target-drvs)
+ #:search-paths paths
+ #:native-search-paths npaths
+ #:outputs (bag-outputs bag)
+ #:system system #:target target
+ (bag-arguments bag)))))
(define* (package-output store package
#:optional (output "out") (system (%current-system)))
(valid-path? %store out))))
(test-assert "gnu-build-system"
- (and (build-system? gnu-build-system)
- (eq? gnu-build (build-system-builder gnu-build-system))))
+ (build-system? gnu-build-system))
(unless network-reachable? (test-skip 1))
(test-assert "gnu-build"
"0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6"))
(tarball (url-fetch %store url 'sha256 hash
#:guile %bootstrap-guile))
- (build (gnu-build %store "hello-2.8" tarball
- %bootstrap-inputs
- #:implicit-inputs? #f
+ (build (gnu-build %store "hello-2.8"
+ `(("source" ,tarball)
+ ,@%bootstrap-inputs)
#:guile %bootstrap-guile
#:search-paths %bootstrap-search-paths))
(out (derivation->output-path build)))
(test-assert "search paths"
(let* ((p (make-prompt-tag "return-search-paths"))
(s (build-system
- (name "raw")
+ (name 'raw)
(description "Raw build system with direct store access")
- (build (lambda* (store name source inputs
- #:key outputs system search-paths)
- search-paths))))
+ (lower (lambda* (name #:key source inputs #:allow-other-keys)
+ (bag
+ (name name)
+ (build-inputs inputs)
+ (build
+ (lambda* (store name inputs
+ #:key outputs system search-paths)
+ search-paths)))))))
(x (list (search-path-specification
(variable "GUILE_LOAD_PATH")
(directories '("share/guile/site/2.0")))
(test-assert "package-cross-derivation, no cross builder"
(let* ((b (build-system (inherit trivial-build-system)
- (cross-build #f)))
+ (lower (const #f))))
(p (package (inherit (dummy-package "p"))
(build-system b))))
(guard (c ((package-cross-build-system-error? c)
HCoop / jackhill / guix / guix.git / commitdiff