diff options
Diffstat (limited to 'guix')
-rw-r--r-- | guix/build-system/gnu.scm | 63 | ||||
-rw-r--r-- | guix/packages.scm | 40 |
2 files changed, 45 insertions, 58 deletions
diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm index 4f84b3ccee..fa3b3b14b6 100644 --- a/guix/build-system/gnu.scm +++ b/guix/build-system/gnu.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -66,12 +66,8 @@ when GUILE is #f." (location (if (pair? loc) (source-properties->location loc) loc)) (arguments (let ((args (package-arguments p))) - (if (procedure? args) - (lambda (system) - `(#:guile ,guile - #:implicit-inputs? #f ,@(args system))) - `(#:guile ,guile - #:implicit-inputs? #f ,@args)))) + `(#:guile ,guile + #:implicit-inputs? #f ,@args))) (native-inputs (map rewritten-input (filtered-inputs (package-native-inputs p)))) (propagated-inputs (map rewritten-input @@ -95,23 +91,19 @@ configure flags for VARIABLE, the associated value is augmented." (package (inherit p) (arguments - (lambda (system) - (let ((args (match (package-arguments p) - ((? procedure? proc) - (proc system)) - (x x)))) - (substitute-keyword-arguments args - ((#:configure-flags flags) - (let* ((var= (string-append variable "=")) - (len (string-length var=))) - `(cons ,(string-append var= value) - (map (lambda (flag) - (if (string-prefix? ,var= flag) - (string-append - ,(string-append var= value " ") - (substring flag ,len)) - flag)) - ,flags)))))))) + (let ((args (package-arguments p))) + (substitute-keyword-arguments args + ((#:configure-flags flags) + (let* ((var= (string-append variable "=")) + (len (string-length var=))) + `(cons ,(string-append var= value) + (map (lambda (flag) + (if (string-prefix? ,var= flag) + (string-append + ,(string-append var= value " ") + (substring flag ,len)) + flag)) + ,flags))))))) (inputs (rewritten-inputs (package-inputs p))) (propagated-inputs (rewritten-inputs (package-propagated-inputs p)))))) @@ -125,21 +117,14 @@ configure flags for VARIABLE, the associated value is augmented." (package (inherit p) (location (source-properties->location loc)) (arguments - (let ((augment (lambda (args) - (let ((a (default-keyword-arguments args - '(#:configure-flags '() - #:strip-flags #f)))) - (substitute-keyword-arguments a - ((#:configure-flags flags) - `(cons* "--disable-shared" - "LDFLAGS=-static" - ,flags)) - ((#:strip-flags _) - ''("--strip-all"))))))) - (if (procedure? args) - (lambda x - (augment (apply args x))) - (augment args))))))) + (let ((a (default-keyword-arguments args + '(#:configure-flags '() + #:strip-flags #f)))) + (substitute-keyword-arguments a + ((#:configure-flags flags) + `(cons* "--disable-shared" "LDFLAGS=-static" ,flags)) + ((#:strip-flags _) + ''("--strip-all")))))))) (define %store diff --git a/guix/packages.scm b/guix/packages.scm index a9534adfec..a76e51a5d0 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -110,7 +110,7 @@ representation." (source package-source) ; <origin> instance (build-system package-build-system) ; build system (arguments package-arguments ; arguments for the build method - (default '())) + (default '()) (thunked)) (inputs package-inputs ; input packages or derivations (default '())) @@ -290,24 +290,26 @@ PACKAGE for SYSTEM." ;; 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 - (match package - (($ <package> name version source (= build-system-builder builder) - args inputs propagated-inputs native-inputs self-native-input? - outputs) - ;; TODO: For `search-paths', add a builder prologue that calls - ;; `set-path-environment-variable'. - (let ((inputs (map expand-input - (package-transitive-inputs package)))) - - (apply builder - store (package-full-name package) - (and source - (package-source-derivation store source system)) - inputs - #:outputs outputs #:system system - (if (procedure? args) - (args system) - args))))))) + + ;; Bind %CURRENT-SYSTEM so that thunked field values can refer + ;; to it. + (parameterize ((%current-system system)) + (match package + (($ <package> name version source (= build-system-builder builder) + args inputs propagated-inputs native-inputs self-native-input? + outputs) + ;; TODO: For `search-paths', add a builder prologue that calls + ;; `set-path-environment-variable'. + (let ((inputs (map expand-input + (package-transitive-inputs package)))) + + (apply builder + store (package-full-name package) + (and source + (package-source-derivation store source system)) + inputs + #:outputs outputs #:system system + (args)))))))) (define* (package-cross-derivation store package) ;; TODO |