guix-commits
[Top][All Lists]
Advanced

[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")))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]