build-system: Introduce "bags" as an intermediate representation.
* 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.
This commit is contained in:
Ludovic Courtès
parent
2348fd0f51
commit
0d5a559f0f
|
|
@ -17,6 +17,8 @@
|
|||
(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))
|
||||
|
|
|
|||
|
|
@ -1519,6 +1519,13 @@ Build systems are @code{<build-system>} objects. The interface to
|
|||
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
|
||||
|
|
|
|||
|
|
@ -164,6 +164,46 @@ check whether everything is alright."
|
|||
;;; 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.
|
||||
|
|
@ -172,39 +212,9 @@ check whether everything is alright."
|
|||
;; 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")
|
||||
|
|
|
|||
|
|
@ -154,7 +154,7 @@ GCC that does not target a libc; otherwise, target that libc."
|
|||
;; 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)
|
||||
|
|
@ -224,7 +224,9 @@ XBINUTILS and the cross tool chain."
|
|||
(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
|
||||
|
|
@ -243,7 +245,14 @@ XBINUTILS and the cross tool chain."
|
|||
(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)
|
||||
|
|
@ -252,13 +261,16 @@ XBINUTILS and the cross tool chain."
|
|||
`(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)))))
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
;;; 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.
|
||||
;;;
|
||||
|
|
@ -18,17 +18,73 @@
|
|||
|
||||
(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))))
|
||||
|
|
|
|||
|
|
@ -42,44 +42,71 @@
|
|||
(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
|
||||
|
|
@ -103,27 +130,17 @@ provides a 'CMakeLists.txt' file as its build system."
|
|||
(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
|
||||
|
|
|
|||
|
|
@ -23,12 +23,10 @@
|
|||
#: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
|
||||
|
|
@ -201,10 +199,6 @@ listed in REFS."
|
|||
p))
|
||||
|
||||
|
||||
(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."
|
||||
|
|
@ -213,53 +207,47 @@ 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* (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))))
|
||||
|
||||
(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)))
|
||||
(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)
|
||||
|
||||
(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))))
|
||||
;; 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))))
|
||||
|
||||
(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* (gnu-build store name input-drvs
|
||||
#:key (guile #f)
|
||||
(outputs '("out"))
|
||||
(search-paths '())
|
||||
|
|
@ -277,7 +265,6 @@ System: GCC, GNU Make, Bash, Coreutils, etc."
|
|||
"bin" "sbin"))
|
||||
(phases '%standard-phases)
|
||||
(system (%current-system))
|
||||
(implicit-inputs? #t) ; useful when bootstrapping
|
||||
(imported-modules %default-modules)
|
||||
(modules %default-modules)
|
||||
allowed-references)
|
||||
|
|
@ -295,16 +282,6 @@ which could lead to gratuitous input divergence.
|
|||
|
||||
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)
|
||||
|
|
@ -318,15 +295,18 @@ are allowed to refer to."
|
|||
(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
|
||||
|
|
@ -351,17 +331,8 @@ are allowed to refer to."
|
|||
|
||||
(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
|
||||
|
|
@ -388,30 +359,15 @@ is one of `host' or `target'."
|
|||
`(("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 '())
|
||||
|
|
@ -429,7 +385,6 @@ inputs."
|
|||
"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)
|
||||
|
|
@ -438,27 +393,6 @@ inputs."
|
|||
"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)
|
||||
|
|
@ -478,39 +412,39 @@ platform."
|
|||
',(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)))
|
||||
target-drvs))
|
||||
|
||||
(gnu-build #:source ,(if (derivation? source)
|
||||
(derivation->output-path source)
|
||||
source)
|
||||
(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
|
||||
|
|
@ -535,21 +469,8 @@ platform."
|
|||
|
||||
(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
|
||||
|
|
@ -558,8 +479,8 @@ platform."
|
|||
#: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)))
|
||||
|
|
|
|||
|
|
@ -42,9 +42,33 @@
|
|||
(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)
|
||||
|
|
@ -62,20 +86,19 @@
|
|||
(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
|
||||
|
|
@ -95,27 +118,17 @@ provides a `Makefile.PL' file as its build 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
|
||||
|
|
|
|||
|
|
@ -92,9 +92,33 @@ prepended to the name."
|
|||
(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 ''())
|
||||
|
|
@ -111,18 +135,17 @@ prepended to the name."
|
|||
(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
|
||||
|
|
@ -130,8 +153,7 @@ provides a 'setup.py' file as its build system."
|
|||
#: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
|
||||
|
|
@ -143,27 +165,17 @@ provides a 'setup.py' file as its build system."
|
|||
(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
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
;;; 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.
|
||||
;;;
|
||||
|
|
@ -23,9 +24,7 @@
|
|||
#: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))
|
||||
|
||||
|
|
@ -35,9 +34,33 @@
|
|||
(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)
|
||||
|
|
@ -52,25 +75,24 @@
|
|||
(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
|
||||
|
|
@ -82,25 +104,15 @@
|
|||
(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)))
|
||||
|
|
|
|||
|
|
@ -34,42 +34,55 @@
|
|||
(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)))
|
||||
|
|
|
|||
|
|
@ -21,7 +21,7 @@
|
|||
#: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?
|
||||
|
|
@ -73,7 +73,7 @@ type HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if
|
|||
;; 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
|
||||
|
|
|
|||
|
|
@ -92,7 +92,13 @@
|
|||
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:
|
||||
;;;
|
||||
|
|
@ -519,6 +525,24 @@ for the host system (\"native inputs\"), and not target inputs."
|
|||
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)))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Package derivations.
|
||||
|
|
@ -591,6 +615,38 @@ information in exceptions."
|
|||
(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."
|
||||
|
|
@ -599,92 +655,69 @@ information in exceptions."
|
|||
;; 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
|
||||
(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))))
|
||||
|
||||
;; 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))))))))
|
||||
(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)
|
||||
(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))))
|
||||
|
||||
;; 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))))))))
|
||||
(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)))
|
||||
|
|
|
|||
|
|
@ -92,8 +92,7 @@
|
|||
(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"
|
||||
|
|
@ -102,9 +101,9 @@
|
|||
"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)))
|
||||
|
|
|
|||
|
|
@ -279,11 +279,16 @@
|
|||
(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")))
|
||||
|
|
@ -326,7 +331,7 @@
|
|||
|
||||
(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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue