15/28: build-system/asdf: Simplify the use of lisp-eval-program.

[Ricardo Wurmus]

rekado pushed a commit to branch master
in repository guix.

commit b9afcb9ed4547e600b7bc89d0fbf0d8453dc2b3b
Author: Andy Patterson <address@hidden>
Date:   Mon Apr 3 09:01:32 2017 -0400

    build-system/asdf: Simplify the use of lisp-eval-program.
    
    Accept a list of statements, each run within its own `--eval' argument. This
    allows statements to use reader package namespacing after a package has been
    loaded.
    
    * guix/build/lisp-utils.scm (spread-statements): New procedure.
    (lisp-invoke): Rename to ...
    (lisp-invocation): ... this. Use spread-statements. Change interface to 
accept
    list of statements instead of a single statement.
    (asdf-load-all-systems): Simplify returned statements.
    (compile-system): Simplify the program passed to `lisp-eval-program'.
    (test-system): Likewise.
    (generate-executable-for-system): Likewise. Accept the full symbol 
describing
    the asdf operation to use.
    (generate-executable): Document the change.
    (build-program, build-image): Use the new interface.
---
 guix/build/lisp-utils.scm | 83 ++++++++++++++++++-----------------------------
 1 file changed, 31 insertions(+), 52 deletions(-)

diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm
index c48f51c..7d5d41d 100644
--- a/guix/build/lisp-utils.scm
+++ b/guix/build/lisp-utils.scm
@@ -101,66 +101,56 @@ name of an ASD system, and asd-file is the full path to 
its definition."
 (define (lisp-eval-program program)
   "Evaluate PROGRAM with a given LISP implementation."
   (unless (zero? (apply system*
-                        (lisp-invoke (format #f "~S" program))))
+                        (lisp-invocation program)))
     (error "lisp-eval-program failed!" (%lisp) program)))
 
-(define (lisp-invoke program)
+(define (spread-statements program argument-name)
+  "Return a list with the statements from PROGRAM spread between
+ARGUMENT-NAME, a string representing the argument a lisp implementation uses
+to accept statements to be evaluated before starting."
+  (append-map (lambda (statement)
+                (list argument-name (format #f "~S" statement)))
+              program))
+
+(define (lisp-invocation program)
   "Return a list of arguments for system* determining how to invoke LISP
 with PROGRAM."
   (match (%lisp-type)
-    ("sbcl" `(,(%lisp) "--non-interactive" "--eval" ,program))
-    ("ecl" `(,(%lisp) "-eval" ,program "-eval" "(quit)"))
+    ("sbcl" `(,(%lisp) "--non-interactive"
+              ,@(spread-statements program "--eval")))
+    ("ecl" `(,(%lisp)
+             ,@(spread-statements program "--eval")
+             "--eval" "(quit)"))
     (_ (error "The LISP provided is not supported at this time."))))
 
 (define (asdf-load-all systems)
   (map (lambda (system)
-         `(funcall
-           (find-symbol
-            (symbol-name :load-system)
-            (symbol-name :asdf))
-           ,system))
+         `(asdf:load-system ,system))
        systems))
 
 (define (compile-system system asd-file)
   "Use a lisp implementation to compile SYSTEM using asdf.  Load ASD-FILE
 first."
   (lisp-eval-program
-   `(progn
-     (require :asdf)
+   `((require :asdf)
      (let ((*package* (find-package :asdf)))
        (load ,asd-file))
-     (funcall (find-symbol
-               (symbol-name :operate)
-               (symbol-name :asdf))
-              (find-symbol
-               (symbol-name :compile-bundle-op)
-               (symbol-name :asdf))
-              ,system))))
+     (asdf:operate 'asdf:compile-bundle-op ,system))))
 
 (define (system-dependencies system asd-file)
   "Return the dependencies of SYSTEM, as reported by
 asdf:system-depends-on.  First load the system's ASD-FILE."
   (define deps-file ".deps.sexp")
   (define program
-    `(progn
-      (require :asdf)
+    `((require :asdf)
       (let ((*package* (find-package :asdf)))
         (load ,asd-file))
       (with-open-file
        (stream ,deps-file :direction :output)
        (format stream
                "~s~%"
-               (funcall
-                (find-symbol
-                 (symbol-name :system-depends-on)
-                 (symbol-name :asdf))
-
-                (funcall
-                 (find-symbol
-                  (symbol-name :find-system)
-                  (symbol-name :asdf))
-
-                 ,system))))))
+               (asdf:system-depends-on
+                (asdf:find-system ,system))))))
 
   (dynamic-wind
     (lambda _
@@ -192,33 +182,22 @@ asdf:system-depends-on.  First load the system's 
ASD-FILE."
 (define (test-system system asd-file)
   "Use a lisp implementation to test SYSTEM using asdf.  Load ASD-FILE first."
   (lisp-eval-program
-   `(progn
-     (require :asdf)
+   `((require :asdf)
      (let ((*package* (find-package :asdf)))
        (load ,asd-file))
-     (funcall (find-symbol
-               (symbol-name :test-system)
-               (symbol-name :asdf))
-              ,system))))
+     (asdf:test-system ,system))))
 
 (define (string->lisp-keyword . strings)
   "Return a lisp keyword for the concatenation of STRINGS."
   (string->symbol (apply string-append ":" strings)))
 
 (define (generate-executable-for-system type system)
-  "Use LISP to generate an executable, whose TYPE can be \"image\" or
-\"program\".  The latter will always be standalone.  Depends on having created
-a \"SYSTEM-exec\" system which contains the entry program."
+  "Use LISP to generate an executable, whose TYPE can be 'asdf:image-op or
+'asdf:program-op.  The latter will always be standalone.  Depends on having
+created a \"SYSTEM-exec\" system which contains the entry program."
   (lisp-eval-program
-   `(progn
-     (require :asdf)
-     (funcall (find-symbol
-               (symbol-name :operate)
-               (symbol-name :asdf))
-              (find-symbol
-               (symbol-name ,(string->lisp-keyword type "-op"))
-               (symbol-name :asdf))
-              ,(string-append system "-exec")))))
+   `((require :asdf)
+     (asdf:operate ',type ,(string-append system "-exec")))))
 
 (define (generate-executable-wrapper-system system dependencies)
   "Generates a system which can be used by asdf to produce an image or program
@@ -330,7 +309,7 @@ has been bound to the command-line arguments which were 
passed."
   (generate-executable program
                        #:dependencies dependencies
                        #:entry-program entry-program
-                       #:type "program")
+                       #:type 'asdf:program-op)
   (let* ((name (basename program))
          (bin-directory (dirname program)))
     (with-directory-excursion bin-directory
@@ -346,7 +325,7 @@ placing the result in IMAGE.image."
   (generate-executable image
                        #:dependencies dependencies
                        #:entry-program '(nil)
-                       #:type "image")
+                       #:type 'asdf:image-op)
   (let* ((name (basename image))
          (bin-directory (dirname image)))
     (with-directory-excursion bin-directory
@@ -359,7 +338,7 @@ placing the result in IMAGE.image."
                               entry-program
                               type
                               #:allow-other-keys)
-  "Generate an executable by using asdf's TYPE-op, containing whithin the
+  "Generate an executable by using asdf operation TYPE, containing whithin the
 image all DEPENDENCIES, and running ENTRY-PROGRAM in the case of an
 executable."
   (let* ((bin-directory (dirname out-file))