[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/08: build-system: Rewrite using gexps.
|
From: |
David Craven |
|
Subject: |
02/08: build-system: Rewrite using gexps. |
|
Date: |
Fri, 6 Jan 2017 11:16:03 +0000 (UTC) |
dvc pushed a commit to branch wip-build-systems-gexp
in repository guix.
commit 049009a559a8a68cde205633a9284a389300a020
Author: Ludovic Courtès <address@hidden>
Date: Sat Mar 28 19:26:39 2015 +0100
build-system: Rewrite using gexps.
* guix/packages.scm (expand-input): Remove 'store', 'system', and
'cross-system' parameters; add #:native?. Rewrite to return
name/gexp-input tuples.
(bag->derivation): Adjust accordingly. Lower (bag-build bag).
(bag->cross-derivation): Ditto.
* guix/gexp.scm (with-build-variables): New procedure.
* gnu/packages/bootstrap.scm (raw-derivation): New procedure.
(raw-build): Turn into a monadic procedure.
* gnu/packages/commencement.scm (glibc-final)[arguments]: Use
'gexp-input' for the #:allowed-references argument.
* guix/build-system/cmake.scm (cmake-build): Remove 'store' parameter.
Switch to the use of gexps and 'gexp->derivation'.
(lower): Remove #:source from 'private-keywords'.
* guix/build-system/glib-or-gtk.scm (glib-or-gtk-build, lower):
Likewise.
* guix/build-system/gnu.scm (gnu-build, gnu-cross-build): Likewise, and
remove 'canonicalize-reference'.
(lower): Likewise.
* guix/build-system/perl.scm (perl-build, lower): Likewise.
* guix/build-system/python.scm (python-build, lower): Likewise.
* guix/build-system/ruby.scm (ruby-build, lower): Likewise.
* guix/build-system/waf.scm (waf-build, lower): Likewise.
* guix/build-system/trivial.scm (guile-for-build): Remove.
(trivial-build): Remove 'store' parameter, change to gexps.
(trivial-cross-build): Ditto.
* tests/builders.scm ("gnu-build"): Call 'store-lower' on 'gnu-build'.
Pass #:source parameter.
* tests/packages.scm ("search paths"): Use 'abort-to-prompt' instead of
a normal return from the 'build' method.
---
.dir-locals.el | 1 +
gnu/packages/bootstrap.scm | 111 ++++++++--------
gnu/packages/commencement.scm | 3 +-
guix/build-system/cmake.scm | 81 +++++-------
guix/build-system/glib-or-gtk.scm | 97 ++++++--------
guix/build-system/gnu.scm | 260 ++++++++++++++-----------------------
guix/build-system/perl.scm | 71 +++++-----
guix/build-system/python.scm | 69 +++++-----
guix/build-system/ruby.scm | 63 ++++-----
guix/build-system/trivial.scm | 52 ++++----
guix/build-system/waf.scm | 87 ++++++-------
guix/gexp.scm | 26 ++++
guix/packages.scm | 55 ++++----
tests/builders.scm | 10 +-
tests/packages.scm | 6 +-
15 files changed, 432 insertions(+), 560 deletions(-)
diff --git a/.dir-locals.el b/.dir-locals.el
index adcc50c..ecd26f9 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -63,6 +63,7 @@
(eval . (put 'run-with-state 'scheme-indent-function 1))
(eval . (put 'wrap-program 'scheme-indent-function 1))
(eval . (put 'with-imported-modules 'scheme-indent-function 1))
+ (eval . (put 'with-build-variables 'scheme-indent-function 2))
(eval . (put 'call-with-container 'scheme-indent-function 1))
(eval . (put 'container-excursion 'scheme-indent-function 1))
diff --git a/gnu/packages/bootstrap.scm b/gnu/packages/bootstrap.scm
index 9e4a706..a95f935 100644
--- a/gnu/packages/bootstrap.scm
+++ b/gnu/packages/bootstrap.scm
@@ -25,10 +25,13 @@
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
#:use-module (guix build-system trivial)
- #:use-module ((guix store) #:select (add-to-store add-text-to-store))
+ #:use-module ((guix store)
+ #:select (%store-monad interned-file text-file store-lift))
#:use-module ((guix derivations) #:select (derivation))
#:use-module ((guix utils) #:select (gnu-triplet->nix-system))
#:use-module (guix combinators)
+ #:use-module (guix monads)
+ #:use-module (guix utils)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
@@ -186,56 +189,60 @@ successful, or false to signal an error."
;;; Bootstrap packages.
;;;
-(define* (raw-build store name inputs
+(define raw-derivation ;TODO: factorize
+ (store-lift derivation))
+
+(define* (raw-build 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
- system)
- (error "bootstrap binary not found"
- file system))))
-
- (let* ((tar (->store "tar"))
- (xz (->store "xz"))
- (mkdir (->store "mkdir"))
- (bash (->store "bash"))
- (guile (->store (match system
- ("armhf-linux"
- "guile-2.0.11.tar.xz")
- (_
- "guile-2.0.9.tar.xz"))))
- ;; The following code, run by the bootstrap guile after it is
- ;; unpacked, creates a wrapper for itself to set its load path.
- ;; This replaces the previous non-portable method based on
- ;; reading the /proc/self/exe symlink.
- (make-guile-wrapper
- '(begin
- (use-modules (ice-9 match))
- (match (command-line)
- ((_ out bash)
- (let ((bin-dir (string-append out "/bin"))
- (guile (string-append out "/bin/guile"))
- (guile-real (string-append out "/bin/.guile-real"))
- ;; We must avoid using a bare dollar sign in this code,
- ;; because it would be interpreted by the shell.
- (dollar (string (integer->char 36))))
- (chmod bin-dir #o755)
- (rename-file guile guile-real)
- (call-with-output-file guile
- (lambda (p)
- (format p "\
+ (interned-file (or (search-bootstrap-binary file system)
+ (error "bootstrap binary not found"
+ file system))
+ file
+ #:recursive? #t))
+
+ (define (make-guile-wrapper bash guile-real)
+ ;; The following code, run by the bootstrap guile after it is unpacked,
+ ;; creates a wrapper for itself to set its load path. This replaces the
+ ;; previous non-portable method based on reading the /proc/self/exe
+ ;; symlink.
+ '(begin
+ (use-modules (ice-9 match))
+ (match (command-line)
+ ((_ out bash)
+ (let ((bin-dir (string-append out "/bin"))
+ (guile (string-append out "/bin/guile"))
+ (guile-real (string-append out "/bin/.guile-real"))
+ ;; We must avoid using a bare dollar sign in this code,
+ ;; because it would be interpreted by the shell.
+ (dollar (string (integer->char 36))))
+ (chmod bin-dir #o755)
+ (rename-file guile guile-real)
+ (call-with-output-file guile
+ (lambda (p)
+ (format p "\
#!~a
export GUILE_SYSTEM_PATH=~a/share/guile/2.0
export GUILE_SYSTEM_COMPILED_PATH=~a/lib/guile/2.0/ccache
exec -a \"~a0\" ~a \"address@hidden"\n"
- bash out out dollar guile-real dollar)))
- (chmod guile #o555)
- (chmod bin-dir #o555))))))
- (builder
- (add-text-to-store store
- "build-bootstrap-guile.sh"
- (format #f "
+ bash out out dollar guile-real dollar)))
+ (chmod guile #o555)
+ (chmod bin-dir #o555))))))
+
+ (mlet* %store-monad ((tar (->store "tar"))
+ (xz (->store "xz"))
+ (mkdir (->store "mkdir"))
+ (bash (->store "bash"))
+ (guile (->store (match system
+ ("armhf-linux"
+ "guile-2.0.11.tar.xz")
+ (_
+ "guile-2.0.9.tar.xz"))))
+ (wrapper -> (make-guile-wrapper bash guile))
+ (builder
+ (text-file "build-bootstrap-guile.sh"
+ (format #f "
echo \"unpacking bootstrap Guile to '$out'...\"
~a $out
cd $out
@@ -248,14 +255,14 @@ $out/bin/guile -c ~s $out ~a
# Sanity check.
$out/bin/guile --version~%"
- mkdir xz guile tar
- (format #f "~s" make-guile-wrapper)
- bash)
- (list mkdir xz guile tar bash))))
- (derivation store name
- bash `(,builder)
- #:system system
- #:inputs `((,bash) (,builder)))))
+ mkdir xz guile tar
+ (object->string wrapper)
+ bash)
+ (list mkdir xz guile tar))))
+ (raw-derivation name
+ bash `(,builder)
+ #:system system
+ #:inputs `((,bash) (,builder)))))
(define* (make-raw-bag name
#:key source inputs native-inputs outputs
diff --git a/gnu/packages/commencement.scm b/gnu/packages/commencement.scm
index c7aa59e..a78a1d3 100644
--- a/gnu/packages/commencement.scm
+++ b/gnu/packages/commencement.scm
@@ -41,6 +41,7 @@
#:use-module (gnu packages hurd)
#:use-module (gnu packages texinfo)
#:use-module (gnu packages pkg-config)
+ #:use-module (guix gexp)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
@@ -631,7 +632,7 @@ exec ~a/bin/~a-~a -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a
\"address@hidden"~%"
;; if 'allowed-references' were per-output.
(arguments
`(#:allowed-references
- ,(cons* `(,gcc-boot0 "lib") (kernel-headers-boot0)
+ ,(cons* (gexp-input gcc-boot0 "lib") (kernel-headers-boot0)
static-bash-for-glibc
(package-outputs glibc-final-with-bootstrap-bash))
diff --git a/guix/build-system/cmake.scm b/guix/build-system/cmake.scm
index 25ac262..dd3b12e 100644
--- a/guix/build-system/cmake.scm
+++ b/guix/build-system/cmake.scm
@@ -19,7 +19,9 @@
(define-module (guix build-system cmake)
#:use-module (guix store)
+ #:use-module (guix gexp)
#:use-module (guix utils)
+ #:use-module (guix monads)
#:use-module (guix derivations)
#:use-module (guix search-paths)
#:use-module (guix build-system)
@@ -56,7 +58,7 @@
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
- '(#:source #:target #:cmake #:inputs #:native-inputs))
+ '(#:target #:cmake #:inputs #:native-inputs))
(and (not target) ;XXX: no cross-compilation
(bag
@@ -75,8 +77,8 @@
(build cmake-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
-(define* (cmake-build store name inputs
- #:key (guile #f)
+(define* (cmake-build name inputs
+ #:key guile source
(outputs '("out")) (configure-flags ''())
(search-paths '())
(make-flags ''())
@@ -99,51 +101,38 @@
(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 ,(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
- search-paths)
- #:phases ,phases
- #:configure-flags ,configure-flags
- #:make-flags ,make-flags
- #:out-of-source? ,out-of-source?
- #:build-type ,build-type
- #:tests? ,tests?
- #:test-target ,test-target
- #:parallel-build? ,parallel-build?
- #:parallel-tests? ,parallel-tests?
- #:validate-runpath? ,validate-runpath?
- #:patch-shebangs? ,patch-shebangs?
- #:strip-binaries? ,strip-binaries?
- #:strip-flags ,strip-flags
- #:strip-directories ,strip-directories)))
+ (define build
+ #~(begin
+ (use-modules ,@modules)
- (define guile-for-build
- (match guile
- ((? package?)
- (package-derivation store guile system #:graft? #f))
- (#f ; the default
- (let* ((distro (resolve-interface '(gnu packages commencement)))
- (guile (module-ref distro 'guile-final)))
- (package-derivation store guile system #:graft? #f)))))
+ #$(with-build-variables inputs outputs
+ #~(cmake-build #:source #+source
+ #:system #$system
+ #:outputs %outputs
+ #:inputs %build-inputs
+ #:search-paths '#$(map
search-path-specification->sexp
+ search-paths)
+ #:phases #$phases
+ #:configure-flags #$configure-flags
+ #:make-flags #$make-flags
+ #:out-of-source? #$out-of-source?
+ #:build-type #$build-type
+ #:tests? #$tests?
+ #:test-target #$test-target
+ #:parallel-build? #$parallel-build?
+ #:parallel-tests? #$parallel-tests?
+ #:validate-runpath? #$validate-runpath?
+ #:patch-shebangs? #$patch-shebangs?
+ #:strip-binaries? #$strip-binaries?
+ #:strip-flags #$strip-flags
+ #:strip-directories #$strip-directories))))
- (build-expression->derivation store name builder
- #:system system
- #:inputs inputs
- #:modules imported-modules
- #:outputs outputs
- #:guile-for-build guile-for-build))
+ (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
+ system #:graft? #f)))
+ (gexp->derivation name build
+ #:system system
+ #:modules imported-modules
+ #:guile-for-build guile)))
(define cmake-build-system
(build-system
diff --git a/guix/build-system/glib-or-gtk.scm
b/guix/build-system/glib-or-gtk.scm
index d585d84..27bc127 100644
--- a/guix/build-system/glib-or-gtk.scm
+++ b/guix/build-system/glib-or-gtk.scm
@@ -21,6 +21,8 @@
(define-module (guix build-system glib-or-gtk)
#:use-module (guix store)
#:use-module (guix utils)
+ #:use-module (guix gexp)
+ #:use-module (guix monads)
#:use-module (guix derivations)
#:use-module (guix search-paths)
#:use-module (guix build-system)
@@ -85,7 +87,7 @@
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
- '(#:source #:target #:glib #:inputs #:native-inputs
+ '(#:target #:glib #:inputs #:native-inputs
#:outputs #:implicit-inputs?))
(and (not target) ;XXX: no cross-compilation
@@ -105,8 +107,8 @@
(build glib-or-gtk-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
-(define* (glib-or-gtk-build store name inputs
- #:key (guile #f)
+(define* (glib-or-gtk-build name inputs
+ #:key guile source
(outputs '("out"))
(search-paths '())
(configure-flags ''())
@@ -130,66 +132,41 @@
(modules %default-modules)
allowed-references)
"Build SOURCE with INPUTS. See GNU-BUILD for more details."
- (define canonicalize-reference
- (match-lambda
- ((? package? p)
- (derivation->output-path (package-derivation store p system)))
- (((? package? p) output)
- (derivation->output-path (package-derivation store p system)
- output))
- ((? string? output)
- output)))
+ (define build
+ #~(begin
+ (use-modules #$modules)
- (define builder
- `(begin
- (use-modules ,@modules)
- (glib-or-gtk-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
- search-paths)
- #:phases ,phases
- #:glib-or-gtk-wrap-excluded-outputs
- ,glib-or-gtk-wrap-excluded-outputs
- #:configure-flags ,configure-flags
- #:make-flags ,make-flags
- #:out-of-source? ,out-of-source?
- #:tests? ,tests?
- #:test-target ,test-target
- #:parallel-build? ,parallel-build?
- #:parallel-tests? ,parallel-tests?
- #:validate-runpath? ,validate-runpath?
- #:patch-shebangs? ,patch-shebangs?
- #:strip-binaries? ,strip-binaries?
- #:strip-flags ,strip-flags
- #:strip-directories ,strip-directories)))
+ #$(with-build-variables inputs outputs
+ #~(glib-or-gtk-build #:source #+source
+ #:system #$system
+ #:outputs %outputs
+ #:inputs %build-inputs
+ #:search-paths '#$(map
search-path-specification->sexp
+ search-paths)
+ #:phases #$phases
+ #:glib-or-gtk-wrap-excluded-outputs
+ #$glib-or-gtk-wrap-excluded-outputs
+ #:configure-flags #$configure-flags
+ #:make-flags #$make-flags
+ #:out-of-source? #$out-of-source?
+ #:tests? #$tests?
+ #:test-target #$test-target
+ #:parallel-build? #$parallel-build?
+ #:parallel-tests? #$parallel-tests?
+ #:validate-runpath? #$validate-runpath?
+ #:patch-shebangs? #$patch-shebangs?
+ #:strip-binaries? #$strip-binaries?
+ #:strip-flags #$strip-flags
+ #:strip-directories #$strip-directories))))
- (define guile-for-build
- (match guile
- ((? package?)
- (package-derivation store guile system #:graft? #f))
- (#f ; the default
- (let* ((distro (resolve-interface '(gnu packages commencement)))
- (guile (module-ref distro 'guile-final)))
- (package-derivation store guile system #:graft? #f)))))
- (build-expression->derivation store name builder
- #:system system
- #:inputs inputs
- #:modules imported-modules
- #:outputs outputs
- #:allowed-references
- (and allowed-references
- (map canonicalize-reference
- allowed-references))
- #:guile-for-build guile-for-build))
+ (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
+ system #:graft? #f)))
+ (gexp->derivation name build
+ #:system system
+ #:modules imported-modules
+ #:allowed-references allowed-references
+ #:guile-for-build guile)))
(define glib-or-gtk-build-system
(build-system
diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm
index f6df183..676a913 100644
--- a/guix/build-system/gnu.scm
+++ b/guix/build-system/gnu.scm
@@ -20,6 +20,8 @@
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix combinators)
+ #:use-module (guix gexp)
+ #:use-module (guix monads)
#:use-module (guix derivations)
#:use-module (guix search-paths)
#:use-module (guix build-system)
@@ -239,7 +241,7 @@ standard packages used as implicit inputs of the GNU build
system."
#:rest arguments)
"Return a bag for NAME from the given arguments."
(define private-keywords
- `(#:source #:inputs #:native-inputs #:outputs
+ `(#:inputs #:native-inputs #:outputs
#:implicit-inputs? #:implicit-cross-inputs?
,@(if target '() '(#:target))))
@@ -272,8 +274,8 @@ standard packages used as implicit inputs of the GNU build
system."
(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)
+(define* (gnu-build name inputs
+ #:key guile source
(outputs '("out"))
(search-paths '())
(configure-flags ''())
@@ -315,77 +317,42 @@ SUBSTITUTABLE? determines whether users may be able to
use substitutes of the
returned derivations, or whether they should always build it locally.
ALLOWED-REFERENCES can be either #f, or a list of packages that the outputs
-are allowed to refer to. Likewise for DISALLOWED-REFERENCES, which lists
-packages that must not be referenced."
- (define canonicalize-reference
- (match-lambda
- ((? package? p)
- (derivation->output-path (package-derivation store p system
- #:graft? #f)))
- (((? package? p) output)
- (derivation->output-path (package-derivation store p system
- #:graft? #f)
- output))
- ((? string? output)
- output)))
-
+are allowed to refer to."
(define builder
- `(begin
- (use-modules ,@modules)
- (gnu-build #:source ,(match (assoc-ref input-drvs "source")
- (((? derivation? source))
- (derivation->output-path source))
- ((source)
- source)
- (source
- source))
- #:system ,system
- #:build ,build
- #:outputs %outputs
- #:inputs %build-inputs
- #:search-paths ',(map search-path-specification->sexp
- search-paths)
- #:phases ,phases
- #:locale ,locale
- #:configure-flags ,configure-flags
- #:make-flags ,make-flags
- #:out-of-source? ,out-of-source?
- #:tests? ,tests?
- #:test-target ,test-target
- #:parallel-build? ,parallel-build?
- #:parallel-tests? ,parallel-tests?
- #:patch-shebangs? ,patch-shebangs?
- #:strip-binaries? ,strip-binaries?
- #:validate-runpath? ,validate-runpath?
- #:strip-flags ,strip-flags
- #:strip-directories ,strip-directories)))
-
- (define guile-for-build
- (match guile
- ((? package?)
- (package-derivation store guile system #:graft? #f))
- (#f ; the default
- (let* ((distro (resolve-interface '(gnu packages commencement)))
- (guile (module-ref distro 'guile-final)))
- (package-derivation store guile system
- #:graft? #f)))))
-
- (build-expression->derivation store name builder
- #:system system
- #:inputs input-drvs
- #:outputs outputs
- #:modules imported-modules
- #:substitutable? substitutable?
-
- #:allowed-references
- (and allowed-references
- (map canonicalize-reference
- allowed-references))
- #:disallowed-references
- (and disallowed-references
- (map canonicalize-reference
- disallowed-references))
- #:guile-for-build guile-for-build))
+ #~(begin
+ (use-modules address@hidden)
+
+ #$(with-build-variables inputs outputs
+ #~(gnu-build #:source #+source
+ #:system #$system
+ #:outputs %outputs
+ #:inputs %build-inputs
+ #:search-paths '#$(map search-path-specification->sexp
+ search-paths)
+ #:phases #$phases
+ #:locale #$locale
+ #:configure-flags #$configure-flags
+ #:make-flags #$make-flags
+ #:out-of-source? #$out-of-source?
+ #:tests? #$tests?
+ #:test-target #$test-target
+ #:parallel-build? #$parallel-build?
+ #:parallel-tests? #$parallel-tests?
+ #:patch-shebangs? #$patch-shebangs?
+ #:validate-runpath? #$validate-runpath?
+ #:strip-binaries? #$strip-binaries?
+ #:strip-flags #$strip-flags
+ #:strip-directories #$strip-directories))))
+
+ (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
+ system #:graft? #f)))
+ (gexp->derivation name builder
+ #:system system
+ #:modules imported-modules
+ #:substitutable? substitutable?
+ #:allowed-references allowed-references
+ #:disallowed-references disallowed-references
+ #:guile-for-build guile)))
;;;
@@ -410,11 +377,10 @@ is one of `host' or `target'."
((target)
`(("cross-libc" ,(libc target)))))))))
-(define* (gnu-cross-build store name
+(define* (gnu-cross-build name
#:key
target native-drvs target-drvs
- (guile #f)
- source
+ guile source
(outputs '("out"))
(search-paths '())
(native-search-paths '())
@@ -444,99 +410,63 @@ is one of `host' or `target'."
"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 canonicalize-reference
- (match-lambda
- ((? package? p)
- (derivation->output-path (package-cross-derivation store p system)))
- (((? package? p) output)
- (derivation->output-path (package-cross-derivation store p system)
- output))
- ((? string? output)
- output)))
-
(define builder
- `(begin
- (use-modules ,@modules)
-
- (let ()
- (define %build-host-inputs
- ',(map (match-lambda
- ((name (? derivation? drv) sub ...)
- `(,name . ,(apply derivation->output-path drv sub)))
- ((name path)
- `(,name . ,path)))
- native-drvs))
-
- (define %build-target-inputs
- ',(map (match-lambda
- ((name (? derivation? drv) sub ...)
- `(,name . ,(apply derivation->output-path drv 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)))
- target-drvs))
-
- (gnu-build #:source ,(match (assoc-ref native-drvs "source")
- (((? derivation? source))
- (derivation->output-path source))
- ((source)
- source)
- (source
- source))
- #:system ,system
- #:build ,build
- #:target ,target
- #:outputs %outputs
- #:inputs %build-target-inputs
- #:native-inputs %build-host-inputs
- #:search-paths ',(map search-path-specification->sexp
+ #~(begin
+ (use-modules address@hidden)
+
+ (define %build-host-inputs
+ (map (lambda (tuple)
+ (apply cons tuple))
+ '#+native-drvs))
+
+ (define %build-target-inputs
+ (map (lambda (tuple)
+ (apply cons tuple))
+ '#$target-drvs))
+
+ (define %outputs
+ (list #$@(map (lambda (name)
+ #~(cons #$name
+ (ungexp output name)))
+ outputs)))
+
+ (gnu-build #:source #+source
+ #:system #$system
+ #:build #$build
+ #:target #$target
+ #:outputs %outputs
+ #:inputs %build-target-inputs
+ #:native-inputs %build-host-inputs
+ #:search-paths '#$(map search-path-specification->sexp
search-paths)
- #:native-search-paths ',(map
+ #:native-search-paths '#$(map
search-path-specification->sexp
native-search-paths)
- #:phases ,phases
- #:locale ,locale
- #:configure-flags ,configure-flags
- #:make-flags ,make-flags
- #:out-of-source? ,out-of-source?
- #:tests? ,tests?
- #:test-target ,test-target
- #:parallel-build? ,parallel-build?
- #:parallel-tests? ,parallel-tests?
- #:patch-shebangs? ,patch-shebangs?
- #:strip-binaries? ,strip-binaries?
- #:validate-runpath? ,validate-runpath?
- #:strip-flags ,strip-flags
- #:strip-directories ,strip-directories))))
-
- (define guile-for-build
- (match guile
- ((? package?)
- (package-derivation store guile system #:graft? #f))
- (#f ; the default
- (let* ((distro (resolve-interface '(gnu packages commencement)))
- (guile (module-ref distro 'guile-final)))
- (package-derivation store guile system #:graft? #f)))))
-
- (build-expression->derivation store name builder
- #:system system
- #:inputs (append native-drvs target-drvs)
- #:outputs outputs
- #:modules imported-modules
- #:substitutable? substitutable?
-
- #:allowed-references
- (and allowed-references
- (map canonicalize-reference
- allowed-references))
- #:disallowed-references
- (and disallowed-references
- (map canonicalize-reference
- disallowed-references))
- #:guile-for-build guile-for-build))
+ #:phases #$phases
+ #:locale #$locale
+ #:configure-flags #$configure-flags
+ #:make-flags #$make-flags
+ #:out-of-source? #$out-of-source?
+ #:tests? #$tests?
+ #:test-target #$test-target
+ #:parallel-build? #$parallel-build?
+ #:parallel-tests? #$parallel-tests?
+ #:patch-shebangs? #$patch-shebangs?
+ #:validate-runpath? #$validate-runpath?
+ #:strip-binaries? #$strip-binaries?
+ #:strip-flags #$strip-flags
+ #:strip-directories #$strip-directories)))
+
+ (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
+ system #:graft? #f)))
+ (gexp->derivation name builder
+ #:system system
+ #:target target
+ #:modules imported-modules
+ #:substitutable? substitutable?
+ #:allowed-references allowed-references
+ #:disallowed-references disallowed-references
+ #:guile-for-build guile)))
(define gnu-build-system
(build-system
diff --git a/guix/build-system/perl.scm b/guix/build-system/perl.scm
index 06af1dd..be0b54d 100644
--- a/guix/build-system/perl.scm
+++ b/guix/build-system/perl.scm
@@ -19,6 +19,8 @@
(define-module (guix build-system perl)
#:use-module (guix store)
#:use-module (guix utils)
+ #:use-module (guix gexp)
+ #:use-module (guix monads)
#:use-module (guix derivations)
#:use-module (guix search-paths)
#:use-module (guix build-system)
@@ -57,7 +59,7 @@
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
- '(#:source #:target #:perl #:inputs #:native-inputs))
+ '(#:target #:perl #:inputs #:native-inputs))
(and (not target) ;XXX: no cross-compilation
(bag
@@ -76,8 +78,8 @@
(build perl-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
-(define* (perl-build store name inputs
- #:key
+(define* (perl-build name inputs
+ #:key source
(search-paths '())
(tests? #t)
(parallel-build? #t)
@@ -95,46 +97,33 @@
(guix build utils))))
"Build SOURCE using PERL, and with INPUTS. This assumes that SOURCE
provides a `Makefile.PL' file as its build system."
- (define builder
- `(begin
- (use-modules ,@modules)
- (perl-build #:name ,name
- #:source ,(match (assoc-ref inputs "source")
- (((? derivation? source))
- (derivation->output-path source))
- ((source)
- source)
- (source
- source))
- #:search-paths ',(map search-path-specification->sexp
- search-paths)
- #:make-maker? ,make-maker?
- #:make-maker-flags ,make-maker-flags
- #:module-build-flags ,module-build-flags
- #:phases ,phases
- #:system ,system
- #:test-target "test"
- #:tests? ,tests?
- #:parallel-build? ,parallel-build?
- #:parallel-tests? ,parallel-tests?
- #:outputs %outputs
- #:inputs %build-inputs)))
+ (define build
+ #~(begin
+ (use-modules address@hidden)
- (define guile-for-build
- (match guile
- ((? package?)
- (package-derivation store guile system #:graft? #f))
- (#f ; the default
- (let* ((distro (resolve-interface '(gnu packages commencement)))
- (guile (module-ref distro 'guile-final)))
- (package-derivation store guile system #:graft? #f)))))
+ #$(with-build-variables inputs outputs
+ #~(perl-build #:name #$name
+ #:source #+source
+ #:search-paths '#$(map
search-path-specification->sexp
+ search-paths)
+ #:make-maker? #$make-maker?
+ #:make-maker-flags #$make-maker-flags
+ #:module-build-flags #$module-build-flags
+ #:phases #$phases
+ #:system #$system
+ #:test-target "test"
+ #:tests? #$tests?
+ #:parallel-build? #$parallel-build?
+ #:parallel-tests? #$parallel-tests?
+ #:outputs %outputs
+ #:inputs %build-inputs))))
- (build-expression->derivation store name builder
- #:system system
- #:inputs inputs
- #:modules imported-modules
- #:outputs outputs
- #:guile-for-build guile-for-build))
+ (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
+ system #:graft? #f)))
+ (gexp->derivation name build
+ #:system system
+ #:modules imported-modules
+ #:guile-for-build guile)))
(define perl-build-system
(build-system
diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm
index d4d3d28..6e03d5f 100644
--- a/guix/build-system/python.scm
+++ b/guix/build-system/python.scm
@@ -22,6 +22,8 @@
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix combinators)
+ #:use-module (guix gexp)
+ #:use-module (guix monads)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix search-paths)
@@ -154,7 +156,7 @@ pre-defined variants."
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
- '(#:source #:target #:python #:inputs #:native-inputs))
+ '(#:target #:python #:inputs #:native-inputs))
(and (not target) ;XXX: no cross-compilation
(bag
@@ -173,8 +175,8 @@ pre-defined variants."
(build python-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
-(define* (python-build store name inputs
- #:key
+(define* (python-build name inputs
+ #:key source
(tests? #t)
(test-target "test")
(use-setuptools? #t)
@@ -190,43 +192,30 @@ pre-defined variants."
(guix build utils))))
"Build SOURCE using PYTHON, and with INPUTS. This assumes that SOURCE
provides a 'setup.py' file as its build system."
- (define builder
- `(begin
- (use-modules ,@modules)
- (python-build #:name ,name
- #: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
- #:tests? ,tests?
- #:use-setuptools? ,use-setuptools?
- #:phases ,phases
- #:outputs %outputs
- #:search-paths ',(map search-path-specification->sexp
- search-paths)
- #:inputs %build-inputs)))
-
- (define guile-for-build
- (match guile
- ((? package?)
- (package-derivation store guile system #:graft? #f))
- (#f ; the default
- (let* ((distro (resolve-interface '(gnu packages commencement)))
- (guile (module-ref distro 'guile-final)))
- (package-derivation store guile system #:graft? #f)))))
-
- (build-expression->derivation store name builder
- #:inputs inputs
- #:system system
- #:modules imported-modules
- #:outputs outputs
- #:guile-for-build guile-for-build))
+ (define build
+ #~(begin
+ (use-modules address@hidden)
+
+ #$(with-build-variables inputs outputs
+ #~(python-build #:name #$name
+ #:source #+source
+ #:configure-flags #$configure-flags
+ #:system #$system
+ #:test-target #$test-target
+ #:tests? #$tests?
+ #:use-setuptools? ,use-setuptools?
+ #:phases #$phases
+ #:outputs %outputs
+ #:search-paths '#$(map
search-path-specification->sexp
+ search-paths)
+ #:inputs %build-inputs))))
+
+ (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
+ system #:graft? #f)))
+ (gexp->derivation name build
+ #:system system
+ #:modules imported-modules
+ #:guile-for-build guile)))
(define python-build-system
(build-system
diff --git a/guix/build-system/ruby.scm b/guix/build-system/ruby.scm
index 8142e85..a0e7a59 100644
--- a/guix/build-system/ruby.scm
+++ b/guix/build-system/ruby.scm
@@ -20,6 +20,8 @@
(define-module (guix build-system ruby)
#:use-module (guix store)
#:use-module (guix utils)
+ #:use-module (guix gexp)
+ #:use-module (guix monads)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix search-paths)
@@ -54,7 +56,7 @@ NAME and VERSION."
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
- '(#:source #:target #:ruby #:inputs #:native-inputs))
+ '(#:target #:ruby #:inputs #:native-inputs))
(and (not target) ;XXX: no cross-compilation
(bag
@@ -73,8 +75,8 @@ NAME and VERSION."
(build ruby-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
-(define* (ruby-build store name inputs
- #:key
+(define* (ruby-build name inputs
+ #:key source
(gem-flags ''())
(test-target "test")
(tests? #t)
@@ -88,42 +90,29 @@ NAME and VERSION."
(modules '((guix build ruby-build-system)
(guix build utils))))
"Build SOURCE using RUBY and INPUTS."
- (define builder
- `(begin
- (use-modules ,@modules)
- (ruby-build #:name ,name
- #:source ,(match (assoc-ref inputs "source")
- (((? derivation? source))
- (derivation->output-path source))
- ((source)
- source)
- (source
- source))
- #:system ,system
- #:gem-flags ,gem-flags
- #:test-target ,test-target
- #:tests? ,tests?
- #:phases ,phases
- #:outputs %outputs
- #:search-paths ',(map search-path-specification->sexp
- search-paths)
- #:inputs %build-inputs)))
+ (define build
+ #~(begin
+ (use-modules address@hidden)
- (define guile-for-build
- (match guile
- ((? package?)
- (package-derivation store guile system #:graft? #f))
- (#f
- (let* ((distro (resolve-interface '(gnu packages commencement)))
- (guile (module-ref distro 'guile-final)))
- (package-derivation store guile system #:graft? #f)))))
+ #$(with-build-variables inputs outputs
+ #~(ruby-build #:name #$name
+ #:source #+source
+ #:system #$system
+ #:gem-flags #$gem-flags
+ #:test-target #$test-target
+ #:tests? #$tests?
+ #:phases #$phases
+ #:outputs %outputs
+ #:search-paths '#$(map
search-path-specification->sexp
+ search-paths)
+ #:inputs %build-inputs))))
- (build-expression->derivation store name builder
- #:inputs inputs
- #:system system
- #:modules imported-modules
- #:outputs outputs
- #:guile-for-build guile-for-build))
+ (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
+ system #:graft? #f)))
+ (gexp->derivation name build
+ #:system system
+ #:modules imported-modules
+ #:guile-for-build guile)))
(define ruby-build-system
(build-system
diff --git a/guix/build-system/trivial.scm b/guix/build-system/trivial.scm
index 350b1df..ff2fd7b 100644
--- a/guix/build-system/trivial.scm
+++ b/guix/build-system/trivial.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <address@hidden>
+;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <address@hidden>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -19,21 +19,13 @@
(define-module (guix build-system trivial)
#:use-module (guix store)
#:use-module (guix utils)
- #:use-module (guix derivations)
+ #:use-module (guix gexp)
+ #:use-module (guix monads)
#:use-module (guix packages)
#:use-module (guix build-system)
#:use-module (ice-9 match)
#:export (trivial-build-system))
-(define (guile-for-build store guile system)
- (match guile
- ((? package?)
- (package-derivation store guile system #:graft? #f))
- (#f ; the default
- (let* ((distro (resolve-interface '(gnu packages commencement)))
- (guile (module-ref distro 'guile-final)))
- (package-derivation store guile system #:graft? #f)))))
-
(define* (lower name
#:key source inputs native-inputs outputs system target
guile builder modules)
@@ -53,34 +45,38 @@
#:builder ,builder
#:modules ,modules))))
-(define* (trivial-build store name inputs
+(define* (trivial-build name inputs
#:key
- outputs guile system builder (modules '())
+ 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 inputs
- #:system system
- #:outputs outputs
- #:modules modules
- #:guile-for-build
- (guile-for-build store guile system)))
+ (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
+ system #:graft? #f)))
+ (gexp->derivation name (with-build-variables inputs outputs builder)
+ #:system system
+ #:target #f
+ #:modules modules
+ #:guile-for-build guile)))
-(define* (trivial-cross-build store name
+(define* (trivial-cross-build name
#:key
target native-drvs target-drvs
outputs guile system builder (modules '())
search-paths native-search-paths)
"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
- #:outputs outputs
- #:modules modules
- #:guile-for-build
- (guile-for-build store guile system)))
+ (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
+ system #:graft? #f)))
+ (gexp->derivation name (with-build-variables
+ (append native-drvs target-drvs)
+ outputs
+ builder)
+ #:system system
+ #:target target
+ #:modules modules
+ #:guile-for-build guile)))
(define trivial-build-system
(build-system
diff --git a/guix/build-system/waf.scm b/guix/build-system/waf.scm
index 044d2a0..62cbc4c 100644
--- a/guix/build-system/waf.scm
+++ b/guix/build-system/waf.scm
@@ -19,6 +19,8 @@
(define-module (guix build-system waf)
#:use-module (guix store)
#:use-module (guix utils)
+ #:use-module (guix gexp)
+ #:use-module (guix monads)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix search-paths)
@@ -52,7 +54,7 @@
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
- '(#:source #:target #:python #:inputs #:native-inputs))
+ '(#:target #:python #:inputs #:native-inputs))
(and (not target) ;XXX: no cross-compilation
(bag
@@ -71,58 +73,45 @@
(build waf-build) ; only change compared to 'lower' in python.scm
(arguments (strip-keyword-arguments private-keywords arguments)))))
-(define* (waf-build store name inputs
- #:key
- (tests? #t)
- (test-target "check")
- (configure-flags ''())
- (phases '(@ (guix build waf-build-system)
- %standard-phases))
- (outputs '("out"))
- (search-paths '())
- (system (%current-system))
- (guile #f)
- (imported-modules %waf-build-system-modules)
- (modules '((guix build waf-build-system)
- (guix build utils))))
+(define* (waf-build name inputs
+ #:key source
+ (tests? #t)
+ (test-target "check")
+ (configure-flags ''())
+ (phases '(@ (guix build waf-build-system)
+ %standard-phases))
+ (outputs '("out"))
+ (search-paths '())
+ (system (%current-system))
+ (guile #f)
+ (imported-modules %waf-build-system-modules)
+ (modules '((guix build waf-build-system)
+ (guix build utils))))
"Build SOURCE with INPUTS. This assumes that SOURCE provides a 'waf' file
as its build system."
- (define builder
- `(begin
- (use-modules ,@modules)
- (waf-build #:name ,name
- #: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
- #:tests? ,tests?
- #:phases ,phases
- #:outputs %outputs
- #:search-paths ',(map search-path-specification->sexp
- search-paths)
- #:inputs %build-inputs)))
+ (define build
+ #~(begin
+ (use-modules address@hidden)
- (define guile-for-build
- (match guile
- ((? package?)
- (package-derivation store guile system #:graft? #f))
- (#f ; the default
- (let* ((distro (resolve-interface '(gnu packages commencement)))
- (guile (module-ref distro 'guile-final)))
- (package-derivation store guile system #:graft? #f)))))
+ #$(with-build-variables inputs outputs
+ #~(waf-build #:name #$name
+ #:source #+source
+ #:configure-flags #$configure-flags
+ #:system #$system
+ #:test-target #$test-target
+ #:tests? #$tests?
+ #:phases #$phases
+ #:outputs %outputs
+ #:search-paths '#$(map search-path-specification->sexp
+ search-paths)
+ #:inputs %build-inputs))))
- (build-expression->derivation store name builder
- #:inputs inputs
- #:system system
- #:modules imported-modules
- #:outputs outputs
- #:guile-for-build guile-for-build))
+ (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
+ system #:graft? #f)))
+ (gexp->derivation name build
+ #:system system
+ #:modules imported-modules
+ #:guile-for-build guile)))
(define waf-build-system
(build-system
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 1f7fbef..36a8d4d 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -68,11 +68,13 @@
file-append-base
file-append-suffix
+ with-build-variables
gexp->derivation
gexp->file
gexp->script
text-file*
mixed-text-file
+
imported-files
imported-modules
compiled-modules
@@ -1025,6 +1027,30 @@ they can refer to each other."
(module-ref (resolve-interface '(gnu packages commencement))
'guile-final))
+(define (with-build-variables inputs outputs body)
+ "Return a gexp that surrounds BODY with a definition of the legacy
+'%build-inputs', '%outputs', and '%output' variables based on INPUTS, a list
+of name/gexp-input tuples, and OUTPUTS, a list of strings."
+
+ ;; These two variables are defined for backward compatibility. They are
+ ;; used by package expressions. These must be top-level defines so that
+ ;; 'use-modules' form in BODY that are required for macro expansion work as
+ ;; expected.
+ (gexp (begin
+ (define %build-inputs
+ (map (lambda (tuple)
+ (apply cons tuple))
+ '(ungexp inputs)))
+ (define %outputs
+ (list (ungexp-splicing
+ (map (lambda (name)
+ (gexp (cons (ungexp name)
+ (ungexp output name))))
+ outputs))))
+ (define %output
+ (assoc-ref %outputs "out"))
+ (ungexp body))))
+
(define (load-path-expression modules)
"Return as a monadic value a gexp that sets '%load-path' and
'%load-compiled-path' to point to MODULES, a list of module names."
diff --git a/guix/packages.scm b/guix/packages.scm
index beb958f..02ccf1e 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -821,37 +821,24 @@ Return the cached result when available."
((_ package system body ...)
(cached (=> %derivation-cache) package system body ...))))
-(define* (expand-input store package input system #:optional cross-system)
- "Expand INPUT, an input tuple, such that it contains only references to
-derivation paths or store paths. PACKAGE is only used to provide contextual
-information in exceptions."
- (define (intern file)
- ;; Add FILE to the store. Set the `recursive?' bit to #t, so that
- ;; file permissions are preserved.
- (add-to-store store (basename file) #t "sha256" file))
-
- (define derivation
- (if cross-system
- (cut package-cross-derivation store <> cross-system system
- #:graft? #f)
- (cut package-derivation store <> system #:graft? #f)))
+(define* (expand-input package input #:key native?)
+ "Expand INPUT, an input tuple, to a name/<gexp-input> tuple. PACKAGE is
+only used to provide contextual information in exceptions."
+ (define (valid? x)
+ (or (package? x) (origin? x) (derivation? x)))
(match input
- (((? string? name) (? package? package))
- (list name (derivation package)))
- (((? string? name) (? package? package)
- (? string? sub-drv))
- (list name (derivation package)
- sub-drv))
- (((? string? name)
- (and (? string?) (? derivation-path?) drv))
- (list name drv))
+ (((? string? name) (? valid? thing))
+ (list name (gexp-input thing #:native? native?)))
+ (((? string? name) (? valid? thing) (? string? output))
+ (list name (gexp-input thing output #:native? native?)))
(((? string? name)
(and (? string?) (? file-exists? file)))
;; Add FILE to the store. When FILE is in the sub-directory of a
;; store path, it needs to be added anyway, so it can be used as a
;; source.
- (list name (intern file)))
+ (list name (gexp-input (local-file file #:recursive? #t)
+ #:native? native?)))
(((? string? name) (? struct? source))
(list name (package-source-derivation store source system)))
(x
@@ -1033,18 +1020,19 @@ error reporting."
(bag->cross-derivation store bag)
(let* ((system (bag-system bag))
(inputs (bag-transitive-inputs bag))
- (input-drvs (map (cut expand-input store context <> system)
- inputs))
(paths (delete-duplicates
(append-map (match-lambda
((_ (? package? p) _ ...)
(package-native-search-paths
p))
(_ '()))
- inputs))))
+ inputs)))
+ (inputs (map (cut expand-input context <>)
+ inputs)))
- (apply (bag-build bag)
- store (bag-name bag) input-drvs
+ ;; TODO: Change to monadic style.
+ (apply (store-lower (bag-build bag))
+ store (bag-name bag) inputs
#:search-paths paths
#:outputs (bag-outputs bag) #:system system
(bag-arguments bag)))))
@@ -1057,13 +1045,13 @@ This is an internal procedure."
(let* ((system (bag-system bag))
(target (bag-target bag))
(host (bag-transitive-host-inputs bag))
- (host-drvs (map (cut expand-input store context <> system target)
+ (host-drvs (map (cut expand-input context <> #:native? #f)
host))
(target* (bag-transitive-target-inputs bag))
- (target-drvs (map (cut expand-input store context <> system)
+ (target-drvs (map (cut expand-input context <> #:native? #t)
target*))
(build (bag-transitive-build-inputs bag))
- (build-drvs (map (cut expand-input store context <> system)
+ (build-drvs (map (cut expand-input context <> #:native? #t)
build))
(all (append build target* host))
(paths (delete-duplicates
@@ -1080,7 +1068,8 @@ This is an internal procedure."
(_ '()))
all))))
- (apply (bag-build bag)
+ ;; TODO: Change to monadic style.
+ (apply (store-lower (bag-build bag))
store (bag-name bag)
#:native-drvs build-drvs
#:target-drvs (append host-drvs target-drvs)
diff --git a/tests/builders.scm b/tests/builders.scm
index bb9e0fa..f369480 100644
--- a/tests/builders.scm
+++ b/tests/builders.scm
@@ -102,11 +102,11 @@
"0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6"))
(tarball (url-fetch* %store url 'sha256 hash
#:guile %bootstrap-guile))
- (build (gnu-build %store "hello-2.8"
- `(("source" ,tarball)
- ,@%bootstrap-inputs)
- #:guile %bootstrap-guile
- #:search-paths %bootstrap-search-paths))
+ (build ((store-lower gnu-build) %store "hello-2.8"
+ %bootstrap-inputs
+ #:source tarball
+ #:guile %bootstrap-guile
+ #:search-paths %bootstrap-search-paths))
(out (derivation->output-path build)))
(and (build-derivations %store (list (pk 'hello-drv build)))
(valid-path? %store out)
diff --git a/tests/packages.scm b/tests/packages.scm
index 247f75c..bfa5180 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -558,9 +558,9 @@
(system system) (target target)
(build-inputs inputs)
(build
- (lambda* (store name inputs
- #:key outputs system search-paths)
- search-paths)))))))
+ (lambda* (name inputs
+ #:key outputs system search-paths)
+ (abort-to-prompt p search-paths))))))))
(x (list (search-path-specification
(variable "GUILE_LOAD_PATH")
(files '("share/guile/site/2.0")))
- branch wip-build-systems-gexp created (now 58fee7f), David Craven, 2017/01/06
- 03/08: gexp: Micro-optimize sexp serialization., David Craven, 2017/01/06
- 05/08: tests: Add 'test-assertm' to (guix tests)., David Craven, 2017/01/06
- 01/08: gnu: bootstrap: Move 'use-modules' forms to the beginning of build expressions., David Craven, 2017/01/06
- 04/08: monads: Micro-optimize 'foldm'., David Craven, 2017/01/06
- 06/08: packages: Turn 'bag->derivation' into a monadic procedure., David Craven, 2017/01/06
- 08/08: DRAFT gexp: Handle list conversion to <gexp-input> in the expanded code., David Craven, 2017/01/06
- 07/08: store: Add a functional object cache and use it in 'lower-object'., David Craven, 2017/01/06
- 02/08: build-system: Rewrite using gexps.,
David Craven <=