TakeV/guix
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

build-system/asdf: Make #:lisp a package argument.

Browse source 
* guix/build-system/asdf.scm (lower): Change argument name to `lisp-type'.
(asdf-build): Change argument name to `lisp-type'.  Remove `lisp' as an
argument to the returned procedure.  Change the argument passed to build
phases to `lisp-type'.
* guix/build/asdf-build-system.scm (copy-source, build, check)
(create-asd-file, symlink-asd-files, cleanup-files, strip): Respect
`lisp-type` argument.
* gnu/packages/lisp.scm (sbcl-stumpwm, sbcl-stumpwm+slynk): Likewise.
This commit is contained in:
Andy Patterson 2017-04-03 09:01:26 -04:00 committed by Ricardo Wurmus
parent 26a16d37ff
commit 6de91ba2a1
No known key found for this signature in database
GPG key ID: 197A5888235FACAC
3 changed files with 40 additions and 37 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
gnu/packages/lisp.scm
View file

@ -856,9 +856,9 @@ (define-public sbcl-stumpwm
'(#: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 outputs inputs #:allow-other-keys) (lambda* (#:key lisp-type outputs inputs #:allow-other-keys)
(build-program (build-program
lisp lisp-type
(string-append (assoc-ref outputs "out") "/bin/stumpwm") (string-append (assoc-ref outputs "out") "/bin/stumpwm")
#:inputs inputs #:inputs inputs
#:entry-program '((stumpwm:stumpwm) 0)))) #:entry-program '((stumpwm:stumpwm) 0))))
@ -1145,10 +1145,10 @@ (define-public sbcl-stumpwm+slynk
((#:phases phases) ((#:phases phases)
`(modify-phases ,phases `(modify-phases ,phases
(replace 'build-program (replace 'build-program
(lambda* (#:key lisp inputs outputs #:allow-other-keys) (lambda* (#:key lisp-type inputs 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 program (build-program lisp-type program
#:inputs inputs #:inputs inputs
#:entry-program '((stumpwm:stumpwm) 0) #:entry-program '((stumpwm:stumpwm) 0)
#:dependencies '("stumpwm" #:dependencies '("stumpwm"

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

@ -232,10 +232,10 @@ (define properties (package-properties pkg))
(properties (alist-delete variant properties))) (properties (alist-delete variant properties)))
pkg)) pkg))
(define (lower lisp-implementation) (define (lower lisp-type)
(lambda* (name (lambda* (name
#:key source inputs outputs native-inputs system target #:key source inputs outputs native-inputs system target
(lisp (default-lisp (string->symbol lisp-implementation))) (lisp (default-lisp (string->symbol lisp-type)))
#:allow-other-keys #:allow-other-keys
#:rest arguments) #:rest arguments)
"Return a bag for NAME" "Return a bag for NAME"
@ -251,18 +251,17 @@ (define private-keywords
'()) '())
,@inputs ,@inputs
,@(standard-packages))) ,@(standard-packages)))
(build-inputs `((,lisp-implementation ,lisp) (build-inputs `((,lisp-type ,lisp)
,@native-inputs)) ,@native-inputs))
(outputs outputs) (outputs outputs)
(build (asdf-build lisp-implementation)) (build (asdf-build lisp-type))
(arguments (strip-keyword-arguments private-keywords arguments)))))) (arguments (strip-keyword-arguments private-keywords arguments))))))
(define (asdf-build lisp-implementation) (define (asdf-build lisp-type)
(lambda* (store name inputs (lambda* (store name inputs
#:key source outputs #:key source outputs
(tests? #t) (tests? #t)
(asd-file #f) (asd-file #f)
(lisp lisp-implementation)
(phases '(@ (guix build asdf-build-system) (phases '(@ (guix build asdf-build-system)
%standard-phases)) %standard-phases))
(search-paths '()) (search-paths '())
@ -280,7 +279,7 @@ (define builder
(derivation->output-path source)) (derivation->output-path source))
((source) source) ((source) source)
(source source)) (source source))
#:lisp ,lisp #:lisp-type ,lisp-type
#:asd-file ,asd-file #:asd-file ,asd-file
#:system ,system #:system ,system
#:tests? ,tests? #:tests? ,tests?

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

@ -104,29 +104,32 @@ (define* (install #:key outputs #:allow-other-keys)
"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 #:allow-other-keys) (define* (copy-source #:key outputs lisp-type #: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) lisp)) (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 "-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 asd-file (define* (build #:key outputs inputs lisp-type 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) lisp)) (name (remove-lisp-from-name (output-path->package-name out)
(source-path (lisp-source-directory out lisp name)) lisp-type))
(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)))) lisp-type))))
(asd-file (and=> asd-file (cut source-asd-file out lisp name <>)))) (asd-file (and=> asd-file
(cut source-asd-file out lisp-type name <>))))
(setenv "ASDF_OUTPUT_TRANSLATIONS" (setenv "ASDF_OUTPUT_TRANSLATIONS"
(replace-escaped-macros (format #f "~S" translations))) (replace-escaped-macros (format #f "~S" translations)))
@ -139,8 +142,8 @@ (define* (build #:key outputs inputs lisp asd-file
(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 (parameterize ((%lisp (string-append
(assoc-ref inputs lisp) "/bin/" lisp))) (assoc-ref inputs lisp-type) "/bin/" lisp-type)))
(compile-system name lisp asd-file)) (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
@ -149,47 +152,48 @@ (define* (build #:key outputs inputs lisp asd-file
(delete-file-recursively cache-directory)))) (delete-file-recursively cache-directory))))
#t) #t)
(define* (check #:key lisp tests? outputs inputs asd-file (define* (check #:key lisp-type 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)) (let* ((name (remove-lisp-from-name (outputs->name outputs) lisp-type))
(out (library-output outputs)) (out (library-output outputs))
(asd-file (and=> asd-file (cut source-asd-file out lisp name <>)))) (asd-file (and=> asd-file
(cut source-asd-file out lisp-type name <>))))
(if tests? (if tests?
(parameterize ((%lisp (string-append (parameterize ((%lisp (string-append
(assoc-ref inputs lisp) "/bin/" lisp))) (assoc-ref inputs lisp-type) "/bin/" lisp-type)))
(test-system name lisp asd-file)) (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 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)) ((name) (remove-lisp-from-name full-name lisp-type))
((new-asd-file) (string-append (library-directory out lisp) ((new-asd-file) (string-append (library-directory out lisp-type)
"/" name ".asd"))) "/" name ".asd")))
(make-asd-file new-asd-file (make-asd-file new-asd-file
#:lisp lisp #: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 #:allow-other-keys) (define* (symlink-asd-files #:key outputs lisp-type #: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) (bundle-asd-file out asd-file lisp-type)
(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
@ -200,11 +204,11 @@ (define* (symlink-asd-files #:key outputs lisp #:allow-other-keys)
(find-files (string-append out %object-prefix) "\\.asd$"))) (find-files (string-append out %object-prefix) "\\.asd$")))
#t) #t)
(define* (cleanup-files #:key outputs lisp (define* (cleanup-files #:key outputs lisp-type
#: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 (match lisp-type
("sbcl" ("sbcl"
(for-each (for-each
(lambda (file) (lambda (file)
@ -216,7 +220,7 @@ (define* (cleanup-files #:key outputs lisp
(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) (with-directory-excursion (library-directory out lisp-type)
(for-each (for-each
(lambda (file) (lambda (file)
(rename-file file (rename-file file
@ -231,9 +235,9 @@ (define* (cleanup-files #:key outputs lisp
(string<> ".." file))))))) (string<> ".." file)))))))
#t) #t)
(define* (strip #:key lisp #:allow-other-keys #:rest args) (define* (strip #:key lisp-type #:allow-other-keys #: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 "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