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/packages.scm | 195 +++++++++++++++++++++++++++++++----------------------- 1 file changed, 114 insertions(+), 81 deletions(-) (limited to 'guix/packages.scm') diff --git a/guix/packages.scm b/guix/packages.scm index 97a2464309..47cd6b95bb 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -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 + (($ 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 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 - - ;; Bind %CURRENT-SYSTEM so that thunked field values can refer - ;; to it. - (parameterize ((%current-system system) - (%current-target-system #f)) - (match package - (($ name version source (= build-system-builder builder) - args inputs propagated-inputs native-inputs self-native-input? - outputs) - (let* ((inputs (package-transitive-inputs package)) - (input-drvs (map (cut expand-input - store package <> system) - inputs)) - (paths (delete-duplicates - (append-map (match-lambda - ((_ (? package? p) _ ...) - (package-native-search-paths - p)) - (_ '())) - inputs)))) - - (apply builder - store (package-full-name package) - (and source - (package-source-derivation store source system)) - input-drvs - #:search-paths paths - #:outputs outputs #:system system - (args)))))))) + (let* ((bag (package->bag package system #f)) + (inputs (bag-transitive-inputs bag)) + (input-drvs (map (cut expand-input + store package <> system) + inputs)) + (paths (delete-duplicates + (append-map (match-lambda + ((_ (? package? p) _ ...) + (package-native-search-paths + p)) + (_ '())) + inputs)))) + + (apply (bag-build bag) + store (bag-name bag) + input-drvs + #:search-paths paths + #:outputs (bag-outputs bag) #:system system + (bag-arguments bag))))) (define* (package-cross-derivation store package target #:optional (system (%current-system))) "Cross-build PACKAGE for TARGET (a GNU triplet) from host SYSTEM (a Guix system identifying string)." (cached package (cons system target) - - ;; Bind %CURRENT-SYSTEM so that thunked field values can refer - ;; to it. - (parameterize ((%current-system system) - (%current-target-system target)) - (match package - (($ name version source - (= build-system-cross-builder builder) - args inputs propagated-inputs native-inputs self-native-input? - outputs) - (unless builder - (raise (condition - (&package-cross-build-system-error - (package package))))) - - (let* ((inputs (package-transitive-target-inputs package)) - (input-drvs (map (cut expand-input - store package <> - system target) - inputs)) - (host (append (if self-native-input? - `(("self" ,package)) - '()) - (package-transitive-native-inputs package))) - (host-drvs (map (cut expand-input - store package <> system) - host)) - (all (append host inputs)) - (paths (delete-duplicates - (append-map (match-lambda - ((_ (? package? p) _ ...) - (package-search-paths p)) - (_ '())) - all))) - (npaths (delete-duplicates - (append-map (match-lambda - ((_ (? package? p) _ ...) - (package-native-search-paths - p)) - (_ '())) - all)))) - - (apply builder - store (package-full-name package) target - (and source - (package-source-derivation store source system)) - input-drvs host-drvs - #:search-paths paths - #:native-search-paths npaths - #:outputs outputs #:system system - (args)))))))) + (let* ((bag (package->bag package system target)) + (host (bag-transitive-host-inputs bag)) + (host-drvs (map (cut expand-input + store package <> + system target) + host)) + (target* (bag-transitive-target-inputs bag)) + (target-drvs (map (cut expand-input + store package <> system) + target*)) + (build (bag-transitive-build-inputs bag)) + (build-drvs (map (cut expand-input + store package <> system) + build)) + (all (append build target* host)) + (paths (delete-duplicates + (append-map (match-lambda + ((_ (? package? p) _ ...) + (package-search-paths p)) + (_ '())) + all))) + (npaths (delete-duplicates + (append-map (match-lambda + ((_ (? package? p) _ ...) + (package-native-search-paths + p)) + (_ '())) + all)))) + + (apply (bag-build bag) + store (bag-name bag) + #:native-drvs build-drvs + #:target-drvs (append host-drvs target-drvs) + #:search-paths paths + #:native-search-paths npaths + #:outputs (bag-outputs bag) + #:system system #:target target + (bag-arguments bag))))) (define* (package-output store package #:optional (output "out") (system (%current-system))) -- cgit v1.2.3