nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Andy Patterson 2017-04-03 09:01:32 -04:00 committed by Ricardo Wurmus
parent ac2592536d
commit b9afcb9ed4
No known key found for this signature in database
GPG Key ID: 197A5888235FACAC
1 changed files with 31 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
guix/build/lisp-utils.scm
View File

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