From 0d5a559f0f81e14c695e5aab178b30edf66088f3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 3 Oct 2014 18:06:16 +0200 Subject: build-system: Introduce "bags" as an intermediate representation. * guix/build-system.scm ()[build, cross-build]: Remove. [lower]: New field. (): 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. --- guix/build-system/gnu.scm | 237 ++++++++++++++++------------------------------ 1 file changed, 79 insertions(+), 158 deletions(-) (limited to 'guix/build-system/gnu.scm') diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm index 372ad14b71..c58dac10bb 100644 --- a/guix/build-system/gnu.scm +++ b/guix/build-system/gnu.scm @@ -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 objects for INPUTS, using -PACKAGE->SEARCH-PATHS to extract the search path specifications of a package." - (append-map (match-lambda - ((_ (? package? p) _ ...) - (package->search-paths p)) - (_ - '())) - inputs)) - -(define (standard-search-paths) - "Return the list of for the standard (implicit) -inputs when doing a native build." - (inputs-search-paths (standard-packages))) - -(define (expand-inputs inputs system) - "Expand INPUTS, which contains objects, so that it contains only -derivations for SYSTEM. Include propagated inputs in the result." - (define input-package->derivation - (match-lambda - ((name pkg sub-drv ...) - (cons* name (package-derivation (%store) pkg system) sub-drv)) - ((name (? derivation-path? path) sub-drv ...) - (cons* name path sub-drv)) - (z - (error "invalid standard input" z)))) - - (map input-package->derivation - (append inputs - (append-map (match-lambda - ((name package _ ...) - (package-transitive-propagated-inputs package))) - inputs)))) - -(define standard-inputs - ;; FIXME: Memoization should be associated with the open store (as for - ;; 'add-text-to-store'), otherwise we get .drv that may not be valid when - ;; switching to another store. - (memoize - (lambda (system) - "Return the list of implicit standard inputs used with the GNU Build -System: GCC, GNU Make, Bash, Coreutils, etc." - (expand-inputs (standard-packages) system)))) - -(define* (gnu-build store name source inputs +(define* (lower name + #:key source inputs native-inputs outputs target + (implicit-inputs? #t) (implicit-cross-inputs? #t) + (strip-binaries? #t) + #:allow-other-keys + #:rest arguments) + "Return a bag for NAME from the given arguments." + (define private-keywords + `(#:source #:inputs #:native-inputs #:outputs + #:implicit-inputs? #:implicit-cross-inputs? + ,@(if target '() '(#:target)))) + + (bag + (name name) + (build-inputs `(,@(if source + `(("source" ,source)) + '()) + ,@native-inputs + ,@(if (and target implicit-cross-inputs?) + (standard-cross-packages target 'host) + '()) + ,@(if implicit-inputs? + (standard-packages) + '()))) + (host-inputs inputs) + + ;; The cross-libc is really a target package, but for bootstrapping + ;; reasons, we can't put it in 'host-inputs'. Namely, 'cross-gcc' is a + ;; native package, so it would end up using a "native" variant of + ;; 'cross-libc' (built with 'gnu-build'), whereas all the other packages + ;; would use a target variant (built with 'gnu-cross-build'.) + (target-inputs (if (and target implicit-cross-inputs?) + (standard-cross-packages target 'target) + '())) + (outputs (if strip-binaries? + outputs + (delete "debug" outputs))) + (build (if target gnu-cross-build gnu-build)) + (arguments (strip-keyword-arguments private-keywords arguments)))) + +(define* (gnu-build store name input-drvs #:key (guile #f) (outputs '("out")) (search-paths '()) @@ -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 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))) - - (gnu-build #:source ,(if (derivation? source) - (derivation->output-path source) - source) + target-drvs)) + + (gnu-build #:source ,(match (assoc-ref native-drvs "source") + (((? derivation? source)) + (derivation->output-path source)) + ((source) + source) + (source + source)) #:system ,system #:target ,target #:outputs %outputs #:inputs %build-target-inputs #:native-inputs %build-host-inputs #:search-paths ',(map search-path-specification->sexp - (append implicit-target-search-paths - search-paths)) + search-paths) #:native-search-paths ',(map search-path-specification->sexp - (append implicit-host-search-paths - native-search-paths)) + native-search-paths) #:phases ,phases #:configure-flags ,configure-flags #:make-flags ,make-flags @@ -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))) -- cgit v1.2.3