me/guix
Archived
1
0
Fork 0
Code Activity

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

Browse source 
* 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

19
gnu/packages/lisp.scm
View file

@ -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
(parameterize ((%lisp-type "sbcl")
(%lisp (string-append (assoc-ref %build-inputs "sbcl")
"/bin/sbcl")))
(build-image (string-append
(assoc-ref %outputs "image")
"/bin/slynk")
#:inputs %build-inputs
#:dependencies ',slynk-systems))))))
#: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))

7
guix/build-system/asdf.scm
View file

@ -273,13 +273,16 @@ set up using CL source package conventions."
(define builder
`(begin
(use-modules ,@modules)
(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))
#:lisp-type ,lisp-type
#:asd-file ,asd-file
#:system ,system
#:tests? ,tests?
@ -287,7 +290,7 @@ set up using CL source package conventions."
#:outputs %outputs
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:inputs %build-inputs)))
#:inputs %build-inputs))))
(define guile-for-build
(match guile

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

@ -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

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

@ -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,10 +114,10 @@ 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
(lisp-eval-program
`(progn
(require :asdf)
(in-package :asdf)
@ -128,7 +133,7 @@ first if SYSTEM is defined there."
(symbol-name :asdf))
,system))))
(define (system-dependencies lisp system asd-file)
(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,34 +162,34 @@ 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
(lisp-eval-program
`(progn
(require :asdf)
(in-package :asdf)
@ -201,12 +206,11 @@ if SYSTEM is defined there."
"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"))))