build-system: asdf: Add asd-operation parameter.

The 'asd-operation' parameter can be used to specify the ASDF operation to use
in the build phase. It's default value is "load-system".

* guix/build-system/asdf.scm (package-with-build-system, asdf-build): Add
  'asd-operation' parameter.
* guix/build/asdf-buid-system.scm (build): Add 'asd-operation' parameter and
  use it.
* guix/build/lisp-utils.scm (compile-systems): Add 'asd-operation' parameter
  and use it.

3 files changed, 14 insertions, 12 deletions

diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm
index 46b0742f6e..74a3e47da1 100644
--- a/guix/build-system/asdf.scm
+++ b/guix/build-system/asdf.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca>
-;;; Copyright © 2019, 2020, 2021 Guillaume Le Vaillant <glv@posteo.net>
+;;; Copyright © 2019, 2020, 2021, 2022 Guillaume Le Vaillant <glv@posteo.net>
 ;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2022 Pierre Neidhardt <mail@ambrevar.xyz>
 ;;;
@@ -203,7 +203,7 @@ set up using CL source package conventions."
       (define base-arguments
         (if target-is-source?
             (strip-keyword-arguments
-             '(#:tests? #:lisp #:asd-systems #:asd-test-systems)
+             '(#:tests? #:lisp #:asd-systems #:asd-test-systems #:asd-operation)
              (package-arguments pkg))
             (package-arguments pkg)))
 
@@ -273,6 +273,7 @@ set up using CL source package conventions."
                  (tests? #t)
                  (asd-systems ''())
                  (asd-test-systems ''())
+                 (asd-operation "load-system")
                  (phases '%standard-phases)
                  (search-paths '())
                  (system (%current-system))
@@ -309,6 +310,7 @@ set up using CL source package conventions."
                           #:source #+source
                           #:asd-systems #$systems
                           #:asd-test-systems #$test-systems
+                          #:asd-operation #$asd-operation
                           #:system #$system
                           #:tests? #$tests?
                           #:phases #$phases
diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm
index 0a3c55c6c4..92154e7d34 100644
--- a/guix/build/asdf-build-system.scm
+++ b/guix/build/asdf-build-system.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca>
-;;; Copyright © 2020, 2021 Guillaume Le Vaillant <glv@posteo.net>
+;;; Copyright © 2020, 2021, 2022 Guillaume Le Vaillant <glv@posteo.net>
 ;;; Copyright © 2022 Pierre Neidhardt <mail@ambrevar.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -181,7 +181,7 @@ if it's present in the native-inputs."
     (setenv "XDG_CONFIG_DIRS" (string-append out "/etc")))
   #t)
 
-(define* (build #:key outputs inputs asd-systems
+(define* (build #:key outputs inputs asd-systems asd-operation
                 #:allow-other-keys)
   "Compile the system."
   (let* ((out (library-output outputs))
@@ -193,7 +193,9 @@ if it's present in the native-inputs."
     (setenv "ASDF_OUTPUT_TRANSLATIONS"
             (replace-escaped-macros (format #f "~S" translations)))
     (setenv "HOME" out) ; ecl's asdf sometimes wants to create $HOME/.cache
-    (compile-systems asd-systems (lisp-source-directory out system-name)))
+    (compile-systems asd-systems
+                     (lisp-source-directory out system-name)
+                     asd-operation))
   #t)
 
 (define* (check #:key tests? outputs inputs asd-test-systems
diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm
index 7c5d865338..646d4a3365 100644
--- a/guix/build/lisp-utils.scm
+++ b/guix/build/lisp-utils.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca>
-;;; Copyright © 2020 Guillaume Le Vaillant <glv@posteo.net>
+;;; Copyright © 2020, 2022 Guillaume Le Vaillant <glv@posteo.net>
 ;;; Copyright © 2022 Pierre Neidhardt <mail@ambrevar.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -108,9 +108,8 @@ with PROGRAM."
              "--eval" "(quit)"))
     (_ (error "The LISP provided is not supported at this time."))))
 
-(define (compile-systems systems directory)
-  "Use a lisp implementation to compile the SYSTEMS using asdf.
-Load ASD-FILES first."
+(define (compile-systems systems directory operation)
+  "Use a lisp implementation to compile the SYSTEMS using asdf."
   (lisp-eval-program
    `((require :asdf)
      (asdf:initialize-source-registry
@@ -119,12 +118,11 @@ Load ASD-FILES first."
                                                                :ensure-directory t))
             :inherit-configuration))
      ,@(map (lambda (system)
-              `(asdf:load-system ,system))
+              (list (string->symbol (string-append "asdf:" operation)) system))
             systems))))
 
 (define (test-system test-systems directory)
-  "Use a lisp implementation to test SYSTEM using asdf.  Load ASD-FILES first.
-Also load TEST-ASD-FILE if necessary."
+  "Use a lisp implementation to test the TEST-SYSTEMS using asdf."
   (lisp-eval-program
    `((require :asdf)
      (asdf:initialize-source-registry