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.  Instead of #:native-drvs and
  #:target-drvs, pass #:build-inputs, #:host-inputs, and #:target-inputs.
  (%derivation-cache): Remove.
* gnu/packages/bootstrap.scm (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/font.scm (font-build): Likewise.
* guix/build-system/gnu.scm (gnu-build): Likewise, and remove
  'canonicalize-reference'.
  (gnu-cross-build): Likewise, and expect #:build-inputs, #:host-inputs,
  and #:target-inputs instead of #:native-drvs and #:target-drvs.
  (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, and change to #:build-inputs & co.
* guix/build-system/cargo.scm (cargo-build): Change to 'gexp->derivation'.
* guix/build-system/copy.scm (copy-build): Likewise.
* guix/build-system/dune.scm (dune-build): Likewise.
* guix/build-system/guile.scm (guile-build, guile-cross-build):
  Likewise.
* guix/build-system/meson.scm (meson-build): Likewise.
* guix/build-system/ocaml.scm (ocaml-build): Likewise.
* guix/build-system/scons.scm (scons-build): Likewise.
* guix/build-system/texlive.scm (texlive-build): Likewise.
* guix/build-system/android-ndk.scm (android-ndk-build): Likewise.
* guix/build-system/ant.scm (ant-build): Likewise.
* guix/build-system/asdf.scm (asdf-build/source, asdf-build): Likewise.
* guix/build-system/chicken.scm (chicken-build): Likewise.
* guix/build-system/clojure.scm (clojure-build): Likewise.
(source->output-path, maybe-guile->guile): Remove.
* guix/build-system/dub.scm (dub-build): Likewise.
* guix/build-system/emacs.scm (emacs-build): Likewise.
* guix/build-system/go.scm (go-build): Likewise.
* guix/build-system/haskell.scm (haskell-build): Likewise.
* guix/build-system/julia.scm (julia-build): Likewise.
* guix/build-system/linux-module.scm (linux-module-build)
(linux-module-build-cross): Likewise.
* guix/build-system/maven.scm (maven-build): Likewise.
* guix/build-system/minify.scm (minify-build): Likewise.
* guix/build-system/node.scm (node-build): Likewise.
* guix/build-system/qt.scm (qt-build, qt-cross-build): Likewise.
* guix/build-system/r.scm (r-build): Likewise.
* guix/build-system/rakudo.scm (rakudo-build): Likewise.
* guix/build-system/renpy.scm (renpy-build): Likewise.
* 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.
  ("package->bag, sensitivity to %current-target-system"): Change 'build'
  to match the new build system signature.

squash! build-system: Rewrite using gexps.

squash! build-system: Rewrite using gexps.

1 files changed, 60 insertions, 84 deletions

diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm
index 28403a1960..5f01d7ccce 100644
--- a/guix/build-system/asdf.scm
+++ b/guix/build-system/asdf.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca>
 ;;; Copyright © 2019, 2020 Guillaume Le Vaillant <glv@posteo.net>
+;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,7 +23,8 @@
   #:use-module (guix utils)
   #:use-module (guix memoization)
   #:use-module (guix packages)
-  #:use-module (guix derivations)
+  #:use-module (guix gexp)
+  #:use-module (guix monads)
   #:use-module (guix search-paths)
   #:use-module ((guix build utils)
                 #:select ((package-name->name+version
@@ -92,7 +94,7 @@
          (build asdf-build/source)
          (arguments (strip-keyword-arguments private-keywords arguments)))))
 
-(define* (asdf-build/source store name inputs
+(define* (asdf-build/source name inputs
                             #:key source outputs
                             (phases '(@ (guix build asdf-build-system)
                                         %standard-phases/source))
@@ -102,36 +104,23 @@
                             (imported-modules %asdf-build-system-modules)
                             (modules %asdf-build-modules))
   (define builder
-    `(begin
-       (use-modules ,@modules)
-       (asdf-build/source #:name ,name
-                          #:source ,(match (assoc-ref inputs "source")
-                                      (((? derivation? source))
-                                       (derivation->output-path source))
-                                      ((source) source)
-                                      (source source))
-                          #:system ,system
-                          #: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
-       (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))
+    (with-imported-modules imported-modules
+      #~(begin
+          (use-modules #$@modules)
+          (asdf-build/source #:name #$name
+                             #:source #+source
+                             #:system #$system
+                             #:phases #$phases
+                             #:outputs #$(outputs->gexp outputs)
+                             #:search-paths '#$(map search-path-specification->sexp
+                                                    search-paths)
+                             #:inputs #$(input-tuples->gexp inputs)))))
+
+  (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
+                                                  system #:graft? #f)))
+    (gexp->derivation name builder
+                      #:system system
+                      #:guile-for-build guile)))
 
 (define* (package-with-build-system from-build-system to-build-system
                                     from-prefix to-prefix
@@ -277,19 +266,19 @@ set up using CL source package conventions."
            (arguments (strip-keyword-arguments private-keywords arguments))))))
 
 (define (asdf-build lisp-type)
-  (lambda* (store name inputs
-                  #:key source outputs
-                  (tests? #t)
-                  (asd-files ''())
-                  (asd-systems ''())
-                  (test-asd-file #f)
-                  (phases '(@ (guix build asdf-build-system)
-                              %standard-phases))
-                  (search-paths '())
-                  (system (%current-system))
-                  (guile #f)
-                  (imported-modules %asdf-build-system-modules)
-                  (modules %asdf-build-modules))
+  (lambda* (name inputs
+                 #:key source outputs
+                 (tests? #t)
+                 (asd-files ''())
+                 (asd-systems ''())
+                 (test-asd-file #f)
+                 (phases '(@ (guix build asdf-build-system)
+                             %standard-phases))
+                 (search-paths '())
+                 (system (%current-system))
+                 (guile #f)
+                 (imported-modules %asdf-build-system-modules)
+                 (modules %asdf-build-modules))
 
     ;; FIXME: The definition of 'systems' is pretty hacky.
     ;; Is there a more elegant way to do it?
@@ -300,48 +289,35 @@ set up using CL source package conventions."
               (string-drop
                ;; NAME is the value returned from `package-full-name'.
                (hyphen-separated-name->name+version name)
-               (1+ (string-length lisp-type))))) ; drop the "<lisp>-" prefix.
+               (1+ (string-length lisp-type)))))  ; drop the "<lisp>-" prefix.
           asd-systems))
 
     (define builder
-      `(begin
-         (use-modules ,@modules)
-         (parameterize ((%lisp (string-append
-                                (assoc-ref %build-inputs ,lisp-type)
-                                "/bin/" ,lisp-type))
-                        (%lisp-type ,lisp-type))
-           (asdf-build #:name ,name
-                       #:source ,(match (assoc-ref inputs "source")
-                                   (((? derivation? source))
-                                    (derivation->output-path source))
-                                   ((source) source)
-                                   (source source))
-                       #:asd-files ,asd-files
-                       #:asd-systems ,systems
-                       #:test-asd-file ,test-asd-file
-                       #:system ,system
-                       #:tests? ,tests?
-                       #: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
-         (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)))
+      (with-imported-modules imported-modules
+        #~(begin
+            (use-modules #$@modules)
+            (parameterize ((%lisp (string-append
+                                   (assoc-ref %build-inputs #$lisp-type)
+                                   "/bin/" #$lisp-type))
+                           (%lisp-type #$lisp-type))
+              (asdf-build #:name #$name
+                          #:source #+source
+                          #:asd-files #$asd-files
+                          #:asd-systems #$systems
+                          #:test-asd-file #$test-asd-file
+                          #:system #$system
+                          #:tests? #$tests?
+                          #:phases #$phases
+                          #:outputs #$(outputs->gexp outputs)
+                          #:search-paths '#$(map search-path-specification->sexp
+                                                 search-paths)
+                          #:inputs #$(input-tuples->gexp inputs))))))
+
+    (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
+                                                    system #:graft? #f)))
+      (gexp->derivation name builder
+                        #:system system
+                        #:guile-for-build guile))))
 
 (define asdf-build-system/sbcl
   (build-system