ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

build-system: Introduce "bags" as an intermediate representation.

Browse source 
* 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 2014-10-03 18:06:16 +02:00
parent 2348fd0f51
commit 0d5a559f0f
15 changed files with 561 additions and 449 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
.dir-locals.el
View file

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

7
doc/guix.texi
View file

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

36
gnu/packages/bootstrap.scm
View file

@ -164,18 +164,9 @@ (define* (glibc-dynamic-linker
;;; Bootstrap packages.
;;;
(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.
;; This is typically built using %GUILE-BOOTSTRAP-TARBALL below.
;;
;; 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* (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
@ -204,7 +195,26 @@ (define (->store file)
(derivation store name
bash `(,builder)
#:system system
#:inputs `((,bash) (,builder)))))))))
#: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.
;; This is typically built using %GUILE-BOOTSTRAP-TARBALL below.
;;
;; 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")
(lower make-raw-bag))))
(package
(name "guile-bootstrap")
(version "2.0")

22
gnu/packages/cross-base.scm
View file

@ -154,7 +154,7 @@ (define* (cross-gcc target
;; 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 @@ (define xlinux-headers
(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 @@ (define xlinux-headers
(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 @@ (define xlinux-headers
`(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)))))

68
guix/build-system.scm
View file

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

59
guix/build-system/cmake.scm
View file

@ -42,12 +42,36 @@ (define (default-cmake)
(let ((module (resolve-interface '(gnu packages cmake))))
(module-ref module 'cmake)))
(define* (cmake-build store name source inputs
(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 ''())
(cmake (default-cmake))
(out-of-source? #t)
(build-type "RelWithDebInfo")
(tests? #t)
@ -71,15 +95,18 @@ (define* (cmake-build store name source inputs
(define builder
`(begin
(use-modules ,@modules)
(cmake-build #:source ,(if (derivation? source)
(derivation->output-path 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 @@ (define guile-for-build
(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))
#:inputs inputs
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build)))
#:guile-for-build guile-for-build))
(define cmake-build-system
(build-system (name 'cmake)
(build-system
(name 'cmake)
(description "The standard CMake build system")
(build cmake-build)))
(lower lower)))
;;; cmake.scm ends here

223
guix/build-system/gnu.scm
View file

@ -23,12 +23,10 @@ (define-module (guix build-system gnu)
#: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 @@ (define (package-with-restricted-references p 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 @@ (define (standard-packages)
(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))
(_
(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)
'()))
inputs))
(outputs (if strip-binaries?
outputs
(delete "debug" outputs)))
(build (if target gnu-cross-build gnu-build))
(arguments (strip-keyword-arguments private-keywords arguments))))
(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* (gnu-build store name input-drvs
#:key (guile #f)
(outputs '("out"))
(search-paths '())
@ -277,7 +265,6 @@ (define* (gnu-build store name source inputs
"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 @@ (define* (gnu-build store name source inputs
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 @@ (define canonicalize-reference
(define builder
`(begin
(use-modules ,@modules)
(gnu-build #:source ,(if (derivation? source)
(derivation->output-path 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 @@ (define guile-for-build
(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 @@ (define standard-cross-packages
`(("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 @@ (define* (gnu-cross-build store name target source inputs native-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 @@ (define* (gnu-cross-build store name target source inputs native-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 @@ (define %build-host-inputs
',(map (match-lambda
((name (? derivation? drv) sub ...)
`(,name . ,(apply derivation->output-path drv sub)))
((name (? derivation-path? drv-path) sub ...)
`(,name . ,(apply derivation-path->output-path
drv-path sub)))
((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)
(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 @@ (define guile-for-build
(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 @@ (define guile-for-build
#:guile-for-build guile-for-build))
(define gnu-build-system
(build-system (name 'gnu)
(build-system
(name 'gnu)
(description
"The GNU Build System—i.e., ./configure && make && make install")
(build gnu-build)
(cross-build gnu-cross-build)))
(lower lower)))

63
guix/build-system/perl.scm
View file

@ -42,9 +42,33 @@ (define (default-perl)
(let ((module (resolve-interface '(gnu packages perl))))
(module-ref module 'perl)))
(define* (perl-build store name source inputs
#:key
(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
(search-paths '())
(tests? #t)
(parallel-build? #t)
@ -62,20 +86,19 @@ (define* (perl-build store name source inputs
(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 ,(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 @@ (define guile-for-build
(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))
#:inputs inputs
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build)))
#:guile-for-build guile-for-build))
(define perl-build-system
(build-system (name 'perl)
(build-system
(name 'perl)
(description "The standard Perl build system")
(build perl-build)))
(lower lower)))
;;; perl.scm ends here

64
guix/build-system/python.scm
View file

@ -92,9 +92,33 @@ (define (package-with-explicit-python p python old-prefix new-prefix)
(define package-with-python2
(cut package-with-explicit-python <> (default-python2) "python-" "python2-"))
(define* (python-build store name source inputs
#:key
(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
(tests? #t)
(test-target "test")
(configure-flags ''())
@ -111,18 +135,17 @@ (define* (python-build store name source inputs
(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 ,(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 @@ (define builder
#: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 @@ (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))
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build)))
#:guile-for-build guile-for-build))
(define python-build-system
(build-system (name 'python)
(build-system
(name 'python)
(description "The standard Python build system")
(build python-build)))
(lower lower)))
;;; python.scm ends here

62
guix/build-system/ruby.scm
View file

@ -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 @@ (define-module (guix build-system ruby)
#: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 @@ (define (default-ruby)
(let ((ruby (resolve-interface '(gnu packages ruby))))
(module-ref ruby 'ruby)))
(define* (ruby-build store name source inputs
#:key
(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
(test-target "test")
(tests? #t)
(phases '(@ (guix build ruby-build-system)
@ -52,25 +75,24 @@ (define* (ruby-build store name source inputs
(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 ,(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 @@ (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))
#:inputs inputs
#:system system
#:modules imported-modules
#:outputs outputs
#:guile-for-build guile-for-build)))
#:guile-for-build guile-for-build))
(define ruby-build-system
(build-system
(name 'ruby)
(description "The standard Ruby build system")
(build ruby-build)))
(lower lower)))

41
guix/build-system/trivial.scm
View file

@ -34,42 +34,55 @@ (define (guile-for-build store guile system)
(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)
(build-system
(name 'trivial)
(description
"Trivial build system, to run arbitrary Scheme build expressions")
(build trivial-build)
(cross-build trivial-cross-build)))
(lower lower)))

4
guix/git-download.scm
View file

@ -21,7 +21,7 @@ (define-module (guix git-download)
#: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 @@ (define inputs
;; 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

131
guix/packages.scm
View file

@ -92,7 +92,13 @@ (define-module (guix packages)
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 @@ (define (package-transitive-propagated-inputs package)
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 @@ (define derivation
(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,16 +655,8 @@ (define* (package-derivation store package
;; 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))
(let* ((bag (package->bag package system #f))
(inputs (bag-transitive-inputs bag))
(input-drvs (map (cut expand-input
store package <> system)
inputs))
@ -620,48 +668,33 @@ (define* (package-derivation store package
(_ '()))
inputs))))
(apply builder
store (package-full-name package)
(and source
(package-source-derivation store source system))
(apply (bag-build bag)
store (bag-name bag)
input-drvs
#:search-paths paths
#:outputs outputs #:system system
(args))))))))
#: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
(let* ((bag (package->bag package system target))
(host (bag-transitive-host-inputs bag))
(host-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))
(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) _ ...)
@ -676,15 +709,15 @@ (define* (package-cross-derivation store package target
(_ '()))
all))))
(apply builder
store (package-full-name package) target
(and source
(package-source-derivation store source system))
input-drvs host-drvs
(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 outputs #:system system
(args))))))))
#:outputs (bag-outputs bag)
#:system system #:target target
(bag-arguments bag)))))
(define* (package-output store package
#:optional (output "out") (system (%current-system)))

9
tests/builders.scm
View file

@ -92,8 +92,7 @@ (define network-reachable?
(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 @@ (define network-reachable?
"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)))

13
tests/packages.scm
View file

@ -279,11 +279,16 @@ (define read-at
(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
(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))))
search-paths)))))))
(x (list (search-path-specification
(variable "GUILE_LOAD_PATH")
(directories '("share/guile/site/2.0")))
@ -326,7 +331,7 @@ (define read-at
(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)