M gnu/packages/lisp.scm => gnu/packages/lisp.scm +11 -12
@@ 856,11 856,9 @@ from other CLXes around the net.")
'(#:phases
(modify-phases %standard-phases
(add-after 'create-symlinks 'build-program
- (lambda* (#:key lisp-type outputs inputs #:allow-other-keys)
+ (lambda* (#:key outputs #:allow-other-keys)
(build-program
- lisp-type
(string-append (assoc-ref outputs "out") "/bin/stumpwm")
- #:inputs inputs
#:entry-program '((stumpwm:stumpwm) 0))))
(add-after 'build-program 'create-desktop-file
(lambda* (#:key outputs #:allow-other-keys)
@@ 1103,12 1101,14 @@ multiple inspectors with independent history.")
(prepend-to-source-registry
(string-append (assoc-ref %outputs "out") "//"))
- (build-image "sbcl"
- (string-append
- (assoc-ref %outputs "image")
- "/bin/slynk")
- #:inputs %build-inputs
- #:dependencies ',slynk-systems))))))
+
+ (parameterize ((%lisp-type "sbcl")
+ (%lisp (string-append (assoc-ref %build-inputs "sbcl")
+ "/bin/sbcl")))
+ (build-image (string-append
+ (assoc-ref %outputs "image")
+ "/bin/slynk")
+ #:dependencies ',slynk-systems)))))))
(define-public ecl-slynk
(package
@@ 1145,11 1145,10 @@ multiple inspectors with independent history.")
((#:phases phases)
`(modify-phases ,phases
(replace 'build-program
- (lambda* (#:key lisp-type inputs outputs #:allow-other-keys)
+ (lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(program (string-append out "/bin/stumpwm")))
- (build-program lisp-type program
- #:inputs inputs
+ (build-program program
#:entry-program '((stumpwm:stumpwm) 0)
#:dependencies '("stumpwm"
,@slynk-systems))
M guix/build-system/asdf.scm => guix/build-system/asdf.scm +18 -15
@@ 273,21 273,24 @@ set up using CL source package conventions."
(define builder
`(begin
(use-modules ,@modules)
- (asdf-build #:name ,name
- #:source ,(match (assoc-ref inputs "source")
- (((? derivation? source))
- (derivation->output-path source))
- ((source) source)
- (source source))
- #:lisp-type ,lisp-type
- #:asd-file ,asd-file
- #:system ,system
- #:tests? ,tests?
- #:phases ,phases
- #:outputs %outputs
- #:search-paths ',(map search-path-specification->sexp
- search-paths)
- #:inputs %build-inputs)))
+ (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-file ,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
M guix/build/asdf-build-system.scm => guix/build/asdf-build-system.scm +32 -42
@@ 43,8 43,8 @@
(define %object-prefix "/lib")
-(define (source-install-prefix lisp)
- (string-append %source-install-prefix "/" lisp "-source"))
+(define (%lisp-source-install-prefix)
+ (string-append %source-install-prefix "/" (%lisp-type) "-source"))
(define %system-install-prefix
(string-append %source-install-prefix "/systems"))
@@ 56,28 56,27 @@
(output-path->package-name
(assoc-ref outputs "out")))
-(define (lisp-source-directory output lisp name)
- (string-append output (source-install-prefix lisp) "/" name))
+(define (lisp-source-directory output name)
+ (string-append output (%lisp-source-install-prefix) "/" name))
(define (source-directory output name)
(string-append output %source-install-prefix "/source/" name))
-(define (library-directory output lisp)
+(define (library-directory output)
(string-append output %object-prefix
- "/" lisp))
+ "/" (%lisp-type)))
(define (output-translation source-path
- object-output
- lisp)
+ object-output)
"Return a translation for the system's source path
to it's binary output."
`((,source-path
:**/ :*.*.*)
- (,(library-directory object-output lisp)
+ (,(library-directory object-output)
:**/ :*.*.*)))
-(define (source-asd-file output lisp name asd-file)
- (string-append (lisp-source-directory output lisp name) "/" asd-file))
+(define (source-asd-file output name asd-file)
+ (string-append (lisp-source-directory output name) "/" asd-file))
(define (library-output outputs)
"If a `lib' output exists, build things there. Otherwise use `out'."
@@ 104,32 103,29 @@ valid."
"Copy and symlink all the source files."
(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."
(let* ((out (library-output outputs))
- (name (remove-lisp-from-name (output-path->package-name out)
- lisp-type))
+ (name (remove-lisp-from-name (output-path->package-name out)))
(install-path (string-append out %source-install-prefix)))
(copy-files-to-output out name)
;; Hide the files from asdf
(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")))
#t)
-(define* (build #:key outputs inputs lisp-type asd-file
+(define* (build #:key outputs inputs asd-file
#:allow-other-keys)
"Compile the system."
(let* ((out (library-output outputs))
- (name (remove-lisp-from-name (output-path->package-name out)
- lisp-type))
- (source-path (lisp-source-directory out lisp-type name))
+ (name (remove-lisp-from-name (output-path->package-name out)))
+ (source-path (lisp-source-directory out name))
(translations (wrap-output-translations
`(,(output-translation source-path
- out
- lisp-type))))
+ out))))
(asd-file (and=> asd-file
- (cut source-asd-file out lisp-type name <>))))
+ (cut source-asd-file out name <>))))
(setenv "ASDF_OUTPUT_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
- (parameterize ((%lisp (string-append
- (assoc-ref inputs lisp-type) "/bin/" lisp-type)))
- (compile-system name lisp-type asd-file))
+ (compile-system name asd-file)
;; As above, ecl will sometimes create this even though it doesn't use it
@@ 152,48 146,44 @@ valid."
(delete-file-recursively cache-directory))))
#t)
-(define* (check #:key lisp-type tests? outputs inputs asd-file
+(define* (check #:key tests? outputs inputs asd-file
#:allow-other-keys)
"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))
(asd-file (and=> asd-file
- (cut source-asd-file out lisp-type name <>))))
+ (cut source-asd-file out name <>))))
(if tests?
- (parameterize ((%lisp (string-append
- (assoc-ref inputs lisp-type) "/bin/" lisp-type)))
- (test-system name lisp-type asd-file))
+ (test-system name asd-file)
(format #t "test suite not run~%")))
#t)
(define* (create-asd-file #:key outputs
inputs
- lisp-type
asd-file
#:allow-other-keys)
"Create a system definition file for the built system."
(let*-values (((out) (library-output outputs))
((full-name version) (package-name->name+version
(strip-store-file-name out)))
- ((name) (remove-lisp-from-name full-name lisp-type))
- ((new-asd-file) (string-append (library-directory out lisp-type)
+ ((name) (remove-lisp-from-name full-name))
+ ((new-asd-file) (string-append (library-directory out)
"/" name ".asd")))
(make-asd-file new-asd-file
- #:lisp lisp-type
#:system name
#:version version
#:inputs inputs
#:system-asd-file asd-file))
#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."
(let* ((out (library-output outputs)))
(for-each
(lambda (asd-file)
(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)
(symlink asd-file new-asd-file)
;; Update the source registry for future phases which might want to
@@ 204,11 194,11 @@ valid."
(find-files (string-append out %object-prefix) "\\.asd$")))
#t)
-(define* (cleanup-files #:key outputs lisp-type
+(define* (cleanup-files #:key outputs
#:allow-other-keys)
"Remove any compiled files which are not a part of the final bundle."
(let ((out (library-output outputs)))
- (match lisp-type
+ (match (%lisp-type)
("sbcl"
(for-each
(lambda (file)
@@ 220,7 210,7 @@ valid."
(append (find-files out "\\.fas$")
(find-files out "\\.o$")))))
- (with-directory-excursion (library-directory out lisp-type)
+ (with-directory-excursion (library-directory out)
(for-each
(lambda (file)
(rename-file file
@@ 235,9 225,9 @@ valid."
(string<> ".." file)))))))
#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
- (or (string=? lisp-type "sbcl")
+ (or (string=? (%lisp-type) "sbcl")
(apply (assoc-ref gnu:%standard-phases 'strip) args)))
(define %standard-phases/source
M guix/build/lisp-utils.scm => guix/build/lisp-utils.scm +67 -68
@@ 25,6 25,7 @@
#:use-module (srfi srfi-26)
#:use-module (guix build utils)
#:export (%lisp
+ %lisp-type
%source-install-prefix
lisp-eval-program
compile-system
@@ 33,7 34,7 @@
generate-executable-wrapper-system
generate-executable-entry-point
generate-executable-for-system
- bundle-install-prefix
+ %bundle-install-prefix
bundle-asd-file
remove-lisp-from-name
wrap-output-translations
@@ 54,24 55,28 @@
;; File name of the Lisp compiler.
(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
;; link farm for system definition (.asd) files.
(define %source-install-prefix "/share/common-lisp")
-(define (bundle-install-prefix lisp)
- (string-append %source-install-prefix "/" lisp "-bundle-systems"))
+(define (%bundle-install-prefix)
+ (string-append %source-install-prefix "/" (%lisp-type) "-bundle-systems"))
(define (remove-lisp-from-name name 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
name of an ASD system, and asd-file is the full path to its definition."
(alist->hash-table
(filter-map
(match-lambda
((_ . path)
- (let ((prefix (string-append path (bundle-install-prefix lisp))))
+ (let ((prefix (string-append path (%bundle-install-prefix))))
(and (directory-exists? prefix)
(match (find-files prefix "\\.asd$")
((asd-file)
@@ 86,16 91,16 @@ name of an ASD system, and asd-file is the full path to its definition."
,@translations
:inherit-configuration))
-(define (lisp-eval-program lisp program)
+(define (lisp-eval-program program)
"Evaluate PROGRAM with a given LISP implementation."
(unless (zero? (apply system*
- (lisp-invoke lisp (format #f "~S" program))))
- (error "lisp-eval-program failed!" lisp program)))
+ (lisp-invoke (format #f "~S" 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
with PROGRAM."
- (match lisp
+ (match (%lisp-type)
("sbcl" `(,(%lisp) "--non-interactive" "--eval" ,program))
("ecl" `(,(%lisp) "-eval" ,program "-eval" "(quit)"))
(_ (error "The LISP provided is not supported at this time."))))
@@ 109,26 114,26 @@ with PROGRAM."
,system))
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
first if SYSTEM is defined there."
- (lisp-eval-program lisp
- `(progn
- (require :asdf)
- (in-package :asdf)
- ,@(if asd-file
- `((load ,asd-file))
- '())
- (in-package :cl-user)
- (funcall (find-symbol
- (symbol-name :operate)
- (symbol-name :asdf))
- (find-symbol
- (symbol-name :compile-bundle-op)
- (symbol-name :asdf))
- ,system))))
-
-(define (system-dependencies lisp system asd-file)
+ (lisp-eval-program
+ `(progn
+ (require :asdf)
+ (in-package :asdf)
+ ,@(if asd-file
+ `((load ,asd-file))
+ '())
+ (in-package :cl-user)
+ (funcall (find-symbol
+ (symbol-name :operate)
+ (symbol-name :asdf))
+ (find-symbol
+ (symbol-name :compile-bundle-op)
+ (symbol-name :asdf))
+ ,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, if necessary."
(define deps-file ".deps.sexp")
@@ 157,56 162,55 @@ asdf:system-depends-on. First load the system's ASD-FILE, if necessary."
(dynamic-wind
(lambda _
- (lisp-eval-program lisp program))
+ (lisp-eval-program program))
(lambda _
(call-with-input-file deps-file read))
(lambda _
(when (file-exists? deps-file)
(delete-file deps-file)))))
-(define (compiled-system system lisp)
- (match lisp
+(define (compiled-system system)
+ (match (%lisp-type)
("sbcl" (string-append system "--system"))
(_ system)))
-(define* (generate-system-definition lisp system
+(define* (generate-system-definition system
#:key version dependencies)
`(asdf:defsystem
,system
:class asdf/bundle:prebuilt-system
:version ,version
:depends-on ,dependencies
- :components ((:compiled-file ,(compiled-system system lisp)))
- ,@(if (string=? "ecl" lisp)
+ :components ((:compiled-file ,(compiled-system system)))
+ ,@(if (string=? "ecl" (%lisp-type))
`(: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
if SYSTEM is defined there."
- (lisp-eval-program lisp
- `(progn
- (require :asdf)
- (in-package :asdf)
- ,@(if asd-file
- `((load ,asd-file))
- '())
- (in-package :cl-user)
- (funcall (find-symbol
- (symbol-name :test-system)
- (symbol-name :asdf))
- ,system))))
+ (lisp-eval-program
+ `(progn
+ (require :asdf)
+ (in-package :asdf)
+ ,@(if asd-file
+ `((load ,asd-file))
+ '())
+ (in-package :cl-user)
+ (funcall (find-symbol
+ (symbol-name :test-system)
+ (symbol-name :asdf))
+ ,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 lisp)
+(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."
(lisp-eval-program
- lisp
`(progn
(require :asdf)
(funcall (find-symbol
@@ 249,7 253,7 @@ ENTRY-PROGRAM for SYSTEM within the current directory."
(declare (ignorable arguments))
,@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
alist of dependency names to corresponding asd files. This allows the system
to locate its dependent systems."
@@ 265,16 269,15 @@ to locate its dependent systems."
registry)))
(define* (make-asd-file asd-file
- #:key lisp system version inputs
+ #:key system version inputs
(system-asd-file #f))
"Create an ASD-FILE for SYSTEM@VERSION, appending a program to allow the
system to find its dependencies, as described by GENERATE-DEPENDENCY-LINKS."
(define dependencies
- (parameterize ((%lisp (string-append (assoc-ref inputs lisp) "/bin/" lisp)))
- (system-dependencies lisp system system-asd-file)))
+ (system-dependencies system system-asd-file))
(define lisp-input-map
- (inputs->asd-file-map inputs lisp))
+ (inputs->asd-file-map inputs))
(define registry
(filter-map hash-get-handle
@@ 291,18 294,18 @@ system to find its dependencies, as described by GENERATE-DEPENDENCY-LINKS."
(display
(replace-escaped-macros
(format #f "~y~%~y~%"
- (generate-system-definition lisp system
+ (generate-system-definition system
#:version version
#:dependencies dependencies)
- (generate-dependency-links lisp registry system)))
+ (generate-dependency-links registry system)))
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
OUTPUT-PATH/share/common-lisp/LISP-bundle-systems/<system>.asd. Returns two
values: the asd file itself and the directory in which it resides."
(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))
bundle-asd-path)))
@@ 317,7 320,7 @@ which are not nested."
(setenv "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)))
entry-program
#:allow-other-keys)
@@ 325,8 328,7 @@ which are not nested."
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'
has been bound to the command-line arguments which were passed."
- (generate-executable lisp program
- #:inputs inputs
+ (generate-executable program
#:dependencies dependencies
#:entry-program entry-program
#:type "program")
@@ 337,13 339,12 @@ has been bound to the command-line arguments which were passed."
name)))
#t)
-(define* (build-image lisp image #:key inputs
+(define* (build-image image #:key
(dependencies (list (basename image)))
#:allow-other-keys)
"Generate an image, possibly standalone, which contains all DEPENDENCIES,
placing the result in IMAGE.image."
- (generate-executable lisp image
- #:inputs inputs
+ (generate-executable image
#:dependencies dependencies
#:entry-program '(nil)
#:type "image")
@@ 354,7 355,7 @@ placing the result in IMAGE.image."
(string-append name ".image"))))
#t)
-(define* (generate-executable lisp out-file #:key inputs
+(define* (generate-executable out-file #:key
dependencies
entry-program
type
@@ 380,9 381,7 @@ executable."
`(((,bin-directory :**/ :*.*.*)
(,bin-directory :**/ :*.*.*)))))))
- (parameterize ((%lisp (string-append
- (assoc-ref inputs lisp) "/bin/" lisp)))
- (generate-executable-for-system type name lisp))
+ (generate-executable-for-system type name)
(delete-file (string-append bin-directory "/" name "-exec.asd"))
(delete-file (string-append bin-directory "/" name "-exec.lisp"))))