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/cmake.scm | 115 +++++++++++--------- guix/build-system/gnu.scm | 237 ++++++++++++++---------------------------- guix/build-system/perl.scm | 75 +++++++------ guix/build-system/python.scm | 76 ++++++++------ guix/build-system/ruby.scm | 76 ++++++++------ guix/build-system/trivial.scm | 45 +++++--- 6 files changed, 306 insertions(+), 318 deletions(-) (limited to 'guix/build-system') diff --git a/guix/build-system/cmake.scm b/guix/build-system/cmake.scm index 5e7fba0ac3..0e750c0e11 100644 --- a/guix/build-system/cmake.scm +++ b/guix/build-system/cmake.scm @@ -42,44 +42,71 @@ (define (default-cmake) (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 @@ (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)) - - #: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 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 @@ (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 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 @@ (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) - 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 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))) - - (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 @@ (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) - (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))) diff --git a/guix/build-system/perl.scm b/guix/build-system/perl.scm index 600e597ce8..6cf8cbe13a 100644 --- a/guix/build-system/perl.scm +++ b/guix/build-system/perl.scm @@ -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 +(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 @@ (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) + #: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)) - - #: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 diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm index a90e7ff511..e28573bb05 100644 --- a/guix/build-system/python.scm +++ b/guix/build-system/python.scm @@ -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 +(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 @@ (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) + #: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)) - - #: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 diff --git a/guix/build-system/ruby.scm b/guix/build-system/ruby.scm index 426ca3718c..8312629fd8 100644 --- a/guix/build-system/ruby.scm +++ b/guix/build-system/ruby.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 David Thompson +;;; Copyright © 2014 Ludovic Courtès ;;; ;;; 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 +(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 @@ (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) + #: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)) - #: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))) diff --git a/guix/build-system/trivial.scm b/guix/build-system/trivial.scm index 897c5c6152..1b07f14e63 100644 --- a/guix/build-system/trivial.scm +++ b/guix/build-system/trivial.scm @@ -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) - (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))) -- cgit v1.2.3