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

build-system/asdf: Parameterize the lisp type and implementation globally. 

* guix/build-system/asdf.scm (asdf-build)[builder]: Parameterize %lisp-type
and %lisp before invoking the build procedure. Don't pass #:lisp-type as an
argument to said procedure.
* guix/build/asdf-build-system.scm: Adjust accordingly.
(source-install-prefix): Rename to %lisp-source-install-prefix.
* guix/build/lisp-utils.scm: Adjust accordingly.
(%lisp-type): New parameter.
(bundle-install-prefix): Rename to %bundle-install-prefix.
* gnu/packages/lisp.scm: Adjust accordingly.
This commit is contained in:
Andy Patterson 2017-04-03 09:01:27 -04:00 committed by Ricardo Wurmus
parent 6de91ba2a1
commit b4c9f0c50d
No known key found for this signature in database
GPG Key ID: 197A5888235FACAC
4 changed files with 127 additions and 136 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
gnu/packages/lisp.scm
View File

@ -856,11 +856,9 @@ from other CLXes around the net.")
'(#:phases '(#:phases
(modify-phases %standard-phases (modify-phases %standard-phases
(add-after 'create-symlinks 'build-program (add-after 'create-symlinks 'build-program
(lambda* (#:key lisp-type outputs inputs #:allow-other-keys) (lambda* (#:key outputs #:allow-other-keys)
(build-program (build-program
lisp-type
(string-append (assoc-ref outputs "out") "/bin/stumpwm") (string-append (assoc-ref outputs "out") "/bin/stumpwm")
#:inputs inputs
#:entry-program '((stumpwm:stumpwm) 0)))) #:entry-program '((stumpwm:stumpwm) 0))))
(add-after 'build-program 'create-desktop-file (add-after 'build-program 'create-desktop-file
(lambda* (#:key outputs #:allow-other-keys) (lambda* (#:key outputs #:allow-other-keys)
@ -1103,12 +1101,14 @@ multiple inspectors with independent history.")
(prepend-to-source-registry (prepend-to-source-registry
(string-append (assoc-ref %outputs "out") "//")) (string-append (assoc-ref %outputs "out") "//"))
(build-image "sbcl"
(string-append (parameterize ((%lisp-type "sbcl")
(assoc-ref %outputs "image") (%lisp (string-append (assoc-ref %build-inputs "sbcl")
"/bin/slynk") "/bin/sbcl")))
#:inputs %build-inputs (build-image (string-append
#:dependencies ',slynk-systems)))))) (assoc-ref %outputs "image")
"/bin/slynk")
#:dependencies ',slynk-systems)))))))
(define-public ecl-slynk (define-public ecl-slynk
(package (package
@ -1145,11 +1145,10 @@ multiple inspectors with independent history.")
((#:phases phases) ((#:phases phases)
`(modify-phases ,phases `(modify-phases ,phases
(replace 'build-program (replace 'build-program
(lambda* (#:key lisp-type inputs outputs #:allow-other-keys) (lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out")) (let* ((out (assoc-ref outputs "out"))
(program (string-append out "/bin/stumpwm"))) (program (string-append out "/bin/stumpwm")))
(build-program lisp-type program (build-program program
#:inputs inputs
#:entry-program '((stumpwm:stumpwm) 0) #:entry-program '((stumpwm:stumpwm) 0)
#:dependencies '("stumpwm" #:dependencies '("stumpwm"
,@slynk-systems)) ,@slynk-systems))

33
guix/build-system/asdf.scm
View File

@ -273,21 +273,24 @@ set up using CL source package conventions."
(define builder (define builder
`(begin `(begin
(use-modules ,@modules) (use-modules ,@modules)
(asdf-build #:name ,name (parameterize ((%lisp (string-append
#:source ,(match (assoc-ref inputs "source") (assoc-ref %build-inputs ,lisp-type)
(((? derivation? source)) "/bin/" ,lisp-type))
(derivation->output-path source)) (%lisp-type ,lisp-type))
((source) source) (asdf-build #:name ,name
(source source)) #:source ,(match (assoc-ref inputs "source")
#:lisp-type ,lisp-type (((? derivation? source))
#:asd-file ,asd-file (derivation->output-path source))
#:system ,system ((source) source)
#:tests? ,tests? (source source))
#:phases ,phases #:asd-file ,asd-file
#:outputs %outputs #:system ,system
#:search-paths ',(map search-path-specification->sexp #:tests? ,tests?
search-paths) #:phases ,phases
#:inputs %build-inputs))) #:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs))))
(define guile-for-build (define guile-for-build
(match guile (match guile

74
guix/build/asdf-build-system.scm
View File

@ -43,8 +43,8 @@
(define %object-prefix "/lib") (define %object-prefix "/lib")
(define (source-install-prefix lisp) (define (%lisp-source-install-prefix)
(string-append %source-install-prefix "/" lisp "-source")) (string-append %source-install-prefix "/" (%lisp-type) "-source"))
(define %system-install-prefix (define %system-install-prefix
(string-append %source-install-prefix "/systems")) (string-append %source-install-prefix "/systems"))
@ -56,28 +56,27 @@
(output-path->package-name (output-path->package-name
(assoc-ref outputs "out"))) (assoc-ref outputs "out")))
(define (lisp-source-directory output lisp name) (define (lisp-source-directory output name)
(string-append output (source-install-prefix lisp) "/" name)) (string-append output (%lisp-source-install-prefix) "/" name))
(define (source-directory output name) (define (source-directory output name)
(string-append output %source-install-prefix "/source/" name)) (string-append output %source-install-prefix "/source/" name))
(define (library-directory output lisp) (define (library-directory output)
(string-append output %object-prefix (string-append output %object-prefix
"/" lisp)) "/" (%lisp-type)))
(define (output-translation source-path (define (output-translation source-path
object-output object-output)
lisp)
"Return a translation for the system's source path "Return a translation for the system's source path
to it's binary output." to it's binary output."
`((,source-path `((,source-path
:**/ :*.*.*) :**/ :*.*.*)
(,(library-directory object-output lisp) (,(library-directory object-output)
:**/ :*.*.*))) :**/ :*.*.*)))
(define (source-asd-file output lisp name asd-file) (define (source-asd-file output name asd-file)
(string-append (lisp-source-directory output lisp name) "/" asd-file)) (string-append (lisp-source-directory output name) "/" asd-file))
(define (library-output outputs) (define (library-output outputs)
"If a `lib' output exists, build things there. Otherwise use `out'." "If a `lib' output exists, build things there. Otherwise use `out'."
@ -104,32 +103,29 @@ valid."
"Copy and symlink all the source files." "Copy and symlink all the source files."
(copy-files-to-output (assoc-ref outputs "out") (outputs->name outputs))) (copy-files-to-output (assoc-ref outputs "out") (outputs->name outputs)))
(define* (copy-source #:key outputs lisp-type #:allow-other-keys) (define* (copy-source #:key outputs #:allow-other-keys)
"Copy the source to the library output." "Copy the source to the library output."
(let* ((out (library-output outputs)) (let* ((out (library-output outputs))
(name (remove-lisp-from-name (output-path->package-name out) (name (remove-lisp-from-name (output-path->package-name out)))
lisp-type))
(install-path (string-append out %source-install-prefix))) (install-path (string-append out %source-install-prefix)))
(copy-files-to-output out name) (copy-files-to-output out name)
;; Hide the files from asdf ;; Hide the files from asdf
(with-directory-excursion install-path (with-directory-excursion install-path
(rename-file "source" (string-append lisp-type "-source")) (rename-file "source" (string-append (%lisp-type) "-source"))
(delete-file-recursively "systems"))) (delete-file-recursively "systems")))
#t) #t)
(define* (build #:key outputs inputs lisp-type asd-file (define* (build #:key outputs inputs asd-file
#:allow-other-keys) #:allow-other-keys)
"Compile the system." "Compile the system."
(let* ((out (library-output outputs)) (let* ((out (library-output outputs))
(name (remove-lisp-from-name (output-path->package-name out) (name (remove-lisp-from-name (output-path->package-name out)))
lisp-type)) (source-path (lisp-source-directory out name))
(source-path (lisp-source-directory out lisp-type name))
(translations (wrap-output-translations (translations (wrap-output-translations
`(,(output-translation source-path `(,(output-translation source-path
out out))))
lisp-type))))
(asd-file (and=> asd-file (asd-file (and=> asd-file
(cut source-asd-file out lisp-type name <>)))) (cut source-asd-file out name <>))))
(setenv "ASDF_OUTPUT_TRANSLATIONS" (setenv "ASDF_OUTPUT_TRANSLATIONS"
(replace-escaped-macros (format #f "~S" translations))) (replace-escaped-macros (format #f "~S" translations)))
@ -141,9 +137,7 @@ valid."
(setenv "HOME" out) ; ecl's asdf sometimes wants to create $HOME/.cache (setenv "HOME" out) ; ecl's asdf sometimes wants to create $HOME/.cache
(parameterize ((%lisp (string-append (compile-system name asd-file)
(assoc-ref inputs lisp-type) "/bin/" lisp-type)))
(compile-system name lisp-type asd-file))
;; As above, ecl will sometimes create this even though it doesn't use it ;; As above, ecl will sometimes create this even though it doesn't use it
@ -152,48 +146,44 @@ valid."
(delete-file-recursively cache-directory)))) (delete-file-recursively cache-directory))))
#t) #t)
(define* (check #:key lisp-type tests? outputs inputs asd-file (define* (check #:key tests? outputs inputs asd-file
#:allow-other-keys) #:allow-other-keys)
"Test the system." "Test the system."
(let* ((name (remove-lisp-from-name (outputs->name outputs) lisp-type)) (let* ((name (remove-lisp-from-name (outputs->name outputs)))
(out (library-output outputs)) (out (library-output outputs))
(asd-file (and=> asd-file (asd-file (and=> asd-file
(cut source-asd-file out lisp-type name <>)))) (cut source-asd-file out name <>))))
(if tests? (if tests?
(parameterize ((%lisp (string-append (test-system name asd-file)
(assoc-ref inputs lisp-type) "/bin/" lisp-type)))
(test-system name lisp-type asd-file))
(format #t "test suite not run~%"))) (format #t "test suite not run~%")))
#t) #t)
(define* (create-asd-file #:key outputs (define* (create-asd-file #:key outputs
inputs inputs
lisp-type
asd-file asd-file
#:allow-other-keys) #:allow-other-keys)
"Create a system definition file for the built system." "Create a system definition file for the built system."
(let*-values (((out) (library-output outputs)) (let*-values (((out) (library-output outputs))
((full-name version) (package-name->name+version ((full-name version) (package-name->name+version
(strip-store-file-name out))) (strip-store-file-name out)))
((name) (remove-lisp-from-name full-name lisp-type)) ((name) (remove-lisp-from-name full-name))
((new-asd-file) (string-append (library-directory out lisp-type) ((new-asd-file) (string-append (library-directory out)
"/" name ".asd"))) "/" name ".asd")))
(make-asd-file new-asd-file (make-asd-file new-asd-file
#:lisp lisp-type
#:system name #:system name
#:version version #:version version
#:inputs inputs #:inputs inputs
#:system-asd-file asd-file)) #:system-asd-file asd-file))
#t) #t)
(define* (symlink-asd-files #:key outputs lisp-type #:allow-other-keys) (define* (symlink-asd-files #:key outputs #:allow-other-keys)
"Create an extra reference to the system in a convenient location." "Create an extra reference to the system in a convenient location."
(let* ((out (library-output outputs))) (let* ((out (library-output outputs)))
(for-each (for-each
(lambda (asd-file) (lambda (asd-file)
(receive (new-asd-file asd-file-directory) (receive (new-asd-file asd-file-directory)
(bundle-asd-file out asd-file lisp-type) (bundle-asd-file out asd-file)
(mkdir-p asd-file-directory) (mkdir-p asd-file-directory)
(symlink asd-file new-asd-file) (symlink asd-file new-asd-file)
;; Update the source registry for future phases which might want to ;; Update the source registry for future phases which might want to
@ -204,11 +194,11 @@ valid."
(find-files (string-append out %object-prefix) "\\.asd$"))) (find-files (string-append out %object-prefix) "\\.asd$")))
#t) #t)
(define* (cleanup-files #:key outputs lisp-type (define* (cleanup-files #:key outputs
#:allow-other-keys) #:allow-other-keys)
"Remove any compiled files which are not a part of the final bundle." "Remove any compiled files which are not a part of the final bundle."
(let ((out (library-output outputs))) (let ((out (library-output outputs)))
(match lisp-type (match (%lisp-type)
("sbcl" ("sbcl"
(for-each (for-each
(lambda (file) (lambda (file)
@ -220,7 +210,7 @@ valid."
(append (find-files out "\\.fas$") (append (find-files out "\\.fas$")
(find-files out "\\.o$"))))) (find-files out "\\.o$")))))
(with-directory-excursion (library-directory out lisp-type) (with-directory-excursion (library-directory out)
(for-each (for-each
(lambda (file) (lambda (file)
(rename-file file (rename-file file
@ -235,9 +225,9 @@ valid."
(string<> ".." file))))))) (string<> ".." file)))))))
#t) #t)
(define* (strip #:key lisp-type #:allow-other-keys #:rest args) (define* (strip #:rest args)
;; stripping sbcl binaries removes their entry program and extra systems ;; stripping sbcl binaries removes their entry program and extra systems
(or (string=? lisp-type "sbcl") (or (string=? (%lisp-type) "sbcl")
(apply (assoc-ref gnu:%standard-phases 'strip) args))) (apply (assoc-ref gnu:%standard-phases 'strip) args)))
(define %standard-phases/source (define %standard-phases/source

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

@ -25,6 +25,7 @@
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (guix build utils) #:use-module (guix build utils)
#:export (%lisp #:export (%lisp
%lisp-type
%source-install-prefix %source-install-prefix
lisp-eval-program lisp-eval-program
compile-system compile-system
@ -33,7 +34,7 @@
generate-executable-wrapper-system generate-executable-wrapper-system
generate-executable-entry-point generate-executable-entry-point
generate-executable-for-system generate-executable-for-system
bundle-install-prefix %bundle-install-prefix
bundle-asd-file bundle-asd-file
remove-lisp-from-name remove-lisp-from-name
wrap-output-translations wrap-output-translations
@ -54,24 +55,28 @@
;; File name of the Lisp compiler. ;; File name of the Lisp compiler.
(make-parameter "lisp")) (make-parameter "lisp"))
(define %lisp-type
;; String representing the class of implementation being used.
(make-parameter "lisp"))
;; The common parent for Lisp source files, as will as the symbolic ;; The common parent for Lisp source files, as will as the symbolic
;; link farm for system definition (.asd) files. ;; link farm for system definition (.asd) files.
(define %source-install-prefix "/share/common-lisp") (define %source-install-prefix "/share/common-lisp")
(define (bundle-install-prefix lisp) (define (%bundle-install-prefix)
(string-append %source-install-prefix "/" lisp "-bundle-systems")) (string-append %source-install-prefix "/" (%lisp-type) "-bundle-systems"))
(define (remove-lisp-from-name name lisp) (define (remove-lisp-from-name name lisp)
(string-drop name (1+ (string-length lisp)))) (string-drop name (1+ (string-length lisp))))
(define (inputs->asd-file-map inputs lisp) (define (inputs->asd-file-map inputs)
"Produce a hash table of the form (system . asd-file), where system is the "Produce a hash table of the form (system . asd-file), where system is the
name of an ASD system, and asd-file is the full path to its definition." name of an ASD system, and asd-file is the full path to its definition."
(alist->hash-table (alist->hash-table
(filter-map (filter-map
(match-lambda (match-lambda
((_ . path) ((_ . path)
(let ((prefix (string-append path (bundle-install-prefix lisp)))) (let ((prefix (string-append path (%bundle-install-prefix))))
(and (directory-exists? prefix) (and (directory-exists? prefix)
(match (find-files prefix "\\.asd$") (match (find-files prefix "\\.asd$")
((asd-file) ((asd-file)
@ -86,16 +91,16 @@ name of an ASD system, and asd-file is the full path to its definition."
,@translations ,@translations
:inherit-configuration)) :inherit-configuration))
(define (lisp-eval-program lisp 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 lisp (format #f "~S" program)))) (lisp-invoke (format #f "~S" program))))
(error "lisp-eval-program failed!" lisp program))) (error "lisp-eval-program failed!" (%lisp) program)))
(define (lisp-invoke lisp program) (define (lisp-invoke 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 (match (%lisp-type)
("sbcl" `(,(%lisp) "--non-interactive" "--eval" ,program)) ("sbcl" `(,(%lisp) "--non-interactive" "--eval" ,program))
("ecl" `(,(%lisp) "-eval" ,program "-eval" "(quit)")) ("ecl" `(,(%lisp) "-eval" ,program "-eval" "(quit)"))
(_ (error "The LISP provided is not supported at this time.")))) (_ (error "The LISP provided is not supported at this time."))))
@ -109,26 +114,26 @@ with PROGRAM."
,system)) ,system))
systems)) systems))
(define (compile-system system lisp 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 if SYSTEM is defined there." first if SYSTEM is defined there."
(lisp-eval-program lisp (lisp-eval-program
`(progn `(progn
(require :asdf) (require :asdf)
(in-package :asdf) (in-package :asdf)
,@(if asd-file ,@(if asd-file
`((load ,asd-file)) `((load ,asd-file))
'()) '())
(in-package :cl-user) (in-package :cl-user)
(funcall (find-symbol (funcall (find-symbol
(symbol-name :operate) (symbol-name :operate)
(symbol-name :asdf)) (symbol-name :asdf))
(find-symbol (find-symbol
(symbol-name :compile-bundle-op) (symbol-name :compile-bundle-op)
(symbol-name :asdf)) (symbol-name :asdf))
,system)))) ,system))))
(define (system-dependencies lisp 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, if necessary." asdf:system-depends-on. First load the system's ASD-FILE, if necessary."
(define deps-file ".deps.sexp") (define deps-file ".deps.sexp")
@ -157,56 +162,55 @@ asdf:system-depends-on. First load the system's ASD-FILE, if necessary."
(dynamic-wind (dynamic-wind
(lambda _ (lambda _
(lisp-eval-program lisp program)) (lisp-eval-program program))
(lambda _ (lambda _
(call-with-input-file deps-file read)) (call-with-input-file deps-file read))
(lambda _ (lambda _
(when (file-exists? deps-file) (when (file-exists? deps-file)
(delete-file deps-file))))) (delete-file deps-file)))))
(define (compiled-system system lisp) (define (compiled-system system)
(match lisp (match (%lisp-type)
("sbcl" (string-append system "--system")) ("sbcl" (string-append system "--system"))
(_ system))) (_ system)))
(define* (generate-system-definition lisp system (define* (generate-system-definition system
#:key version dependencies) #:key version dependencies)
`(asdf:defsystem `(asdf:defsystem
,system ,system
:class asdf/bundle:prebuilt-system :class asdf/bundle:prebuilt-system
:version ,version :version ,version
:depends-on ,dependencies :depends-on ,dependencies
:components ((:compiled-file ,(compiled-system system lisp))) :components ((:compiled-file ,(compiled-system system)))
,@(if (string=? "ecl" lisp) ,@(if (string=? "ecl" (%lisp-type))
`(:lib ,(string-append system ".a")) `(:lib ,(string-append system ".a"))
'()))) '())))
(define (test-system system lisp 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
if SYSTEM is defined there." if SYSTEM is defined there."
(lisp-eval-program lisp (lisp-eval-program
`(progn `(progn
(require :asdf) (require :asdf)
(in-package :asdf) (in-package :asdf)
,@(if asd-file ,@(if asd-file
`((load ,asd-file)) `((load ,asd-file))
'()) '())
(in-package :cl-user) (in-package :cl-user)
(funcall (find-symbol (funcall (find-symbol
(symbol-name :test-system) (symbol-name :test-system)
(symbol-name :asdf)) (symbol-name :asdf))
,system)))) ,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 lisp) (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 \"image\" or
\"program\". The latter will always be standalone. Depends on having created \"program\". The latter will always be standalone. Depends on having created
a \"SYSTEM-exec\" system which contains the entry program." a \"SYSTEM-exec\" system which contains the entry program."
(lisp-eval-program (lisp-eval-program
lisp
`(progn `(progn
(require :asdf) (require :asdf)
(funcall (find-symbol (funcall (find-symbol
@ -249,7 +253,7 @@ ENTRY-PROGRAM for SYSTEM within the current directory."
(declare (ignorable arguments)) (declare (ignorable arguments))
,@entry-program)))))))) ,@entry-program))))))))
(define (generate-dependency-links lisp registry system) (define (generate-dependency-links registry system)
"Creates a program which populates asdf's source registry from REGISTRY, an "Creates a program which populates asdf's source registry from REGISTRY, an
alist of dependency names to corresponding asd files. This allows the system alist of dependency names to corresponding asd files. This allows the system
to locate its dependent systems." to locate its dependent systems."
@ -265,16 +269,15 @@ to locate its dependent systems."
registry))) registry)))
(define* (make-asd-file asd-file (define* (make-asd-file asd-file
#:key lisp system version inputs #:key system version inputs
(system-asd-file #f)) (system-asd-file #f))
"Create an ASD-FILE for SYSTEM@VERSION, appending a program to allow the "Create an ASD-FILE for SYSTEM@VERSION, appending a program to allow the
system to find its dependencies, as described by GENERATE-DEPENDENCY-LINKS." system to find its dependencies, as described by GENERATE-DEPENDENCY-LINKS."
(define dependencies (define dependencies
(parameterize ((%lisp (string-append (assoc-ref inputs lisp) "/bin/" lisp))) (system-dependencies system system-asd-file))
(system-dependencies lisp system system-asd-file)))
(define lisp-input-map (define lisp-input-map
(inputs->asd-file-map inputs lisp)) (inputs->asd-file-map inputs))
(define registry (define registry
(filter-map hash-get-handle (filter-map hash-get-handle
@ -291,18 +294,18 @@ system to find its dependencies, as described by GENERATE-DEPENDENCY-LINKS."
(display (display
(replace-escaped-macros (replace-escaped-macros
(format #f "~y~%~y~%" (format #f "~y~%~y~%"
(generate-system-definition lisp system (generate-system-definition system
#:version version #:version version
#:dependencies dependencies) #:dependencies dependencies)
(generate-dependency-links lisp registry system))) (generate-dependency-links registry system)))
port)))) port))))
(define (bundle-asd-file output-path original-asd-file lisp) (define (bundle-asd-file output-path original-asd-file)
"Find the symlinked bundle file for ORIGINAL-ASD-FILE by looking in "Find the symlinked bundle file for ORIGINAL-ASD-FILE by looking in
OUTPUT-PATH/share/common-lisp/LISP-bundle-systems/<system>.asd. Returns two OUTPUT-PATH/share/common-lisp/LISP-bundle-systems/<system>.asd. Returns two
values: the asd file itself and the directory in which it resides." values: the asd file itself and the directory in which it resides."
(let ((bundle-asd-path (string-append output-path (let ((bundle-asd-path (string-append output-path
(bundle-install-prefix lisp)))) (%bundle-install-prefix))))
(values (string-append bundle-asd-path "/" (basename original-asd-file)) (values (string-append bundle-asd-path "/" (basename original-asd-file))
bundle-asd-path))) bundle-asd-path)))
@ -317,7 +320,7 @@ which are not nested."
(setenv "CL_SOURCE_REGISTRY" (setenv "CL_SOURCE_REGISTRY"
(string-append path ":" (or (getenv "CL_SOURCE_REGISTRY") "")))) (string-append path ":" (or (getenv "CL_SOURCE_REGISTRY") ""))))
(define* (build-program lisp program #:key inputs (define* (build-program program #:key
(dependencies (list (basename program))) (dependencies (list (basename program)))
entry-program entry-program
#:allow-other-keys) #:allow-other-keys)
@ -325,8 +328,7 @@ which are not nested."
execute ENTRY-PROGRAM. The result is placed in PROGRAM. When executed, it execute ENTRY-PROGRAM. The result is placed in PROGRAM. When executed, it
will run ENTRY-PROGRAM, a list of Common Lisp expressions in which `arguments' will run ENTRY-PROGRAM, a list of Common Lisp expressions in which `arguments'
has been bound to the command-line arguments which were passed." has been bound to the command-line arguments which were passed."
(generate-executable lisp program (generate-executable program
#:inputs inputs
#:dependencies dependencies #:dependencies dependencies
#:entry-program entry-program #:entry-program entry-program
#:type "program") #:type "program")
@ -337,13 +339,12 @@ has been bound to the command-line arguments which were passed."
name))) name)))
#t) #t)
(define* (build-image lisp image #:key inputs (define* (build-image image #:key
(dependencies (list (basename image))) (dependencies (list (basename image)))
#:allow-other-keys) #:allow-other-keys)
"Generate an image, possibly standalone, which contains all DEPENDENCIES, "Generate an image, possibly standalone, which contains all DEPENDENCIES,
placing the result in IMAGE.image." placing the result in IMAGE.image."
(generate-executable lisp image (generate-executable image
#:inputs inputs
#:dependencies dependencies #:dependencies dependencies
#:entry-program '(nil) #:entry-program '(nil)
#:type "image") #:type "image")
@ -354,7 +355,7 @@ placing the result in IMAGE.image."
(string-append name ".image")))) (string-append name ".image"))))
#t) #t)
(define* (generate-executable lisp out-file #:key inputs (define* (generate-executable out-file #:key
dependencies dependencies
entry-program entry-program
type type
@ -380,9 +381,7 @@ executable."
`(((,bin-directory :**/ :*.*.*) `(((,bin-directory :**/ :*.*.*)
(,bin-directory :**/ :*.*.*))))))) (,bin-directory :**/ :*.*.*)))))))
(parameterize ((%lisp (string-append (generate-executable-for-system type name)
(assoc-ref inputs lisp) "/bin/" lisp)))
(generate-executable-for-system type name lisp))
(delete-file (string-append bin-directory "/" name "-exec.asd")) (delete-file (string-append bin-directory "/" name "-exec.asd"))
(delete-file (string-append bin-directory "/" name "-exec.lisp")))) (delete-file (string-append bin-directory "/" name "-exec.lisp"))))