Package: guix-patches;
Reported by: Andy Patterson <ajpatter <at> uwaterloo.ca>
Date: Mon, 3 Apr 2017 05:36:01 UTC
Severity: normal
Tags: patch
Done: Ricardo Wurmus <rekado <at> elephly.net>
Bug is archived. No further changes may be made.
To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 26346 in the body.
You can then email your comments to 26346 AT debbugs.gnu.org in the normal way.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Mon, 03 Apr 2017 05:36:01 GMT) Full text and rfc822 format available.Andy Patterson <ajpatter <at> uwaterloo.ca>
:guix-patches <at> gnu.org
.
(Mon, 03 Apr 2017 05:36:01 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Andy Patterson <ajpatter <at> uwaterloo.ca> To: guix-patches <at> gnu.org Subject: [PATCH] asdf-build-system improvements. Date: Mon, 3 Apr 2017 00:37:32 -0400
Hi all, As promised a long time ago, I'm attaching patches to improve the state of the asdf-build-system. As a result, there will be some changes that users should be aware of. Users of stumpwm should include sbcl-stumpwm as opposed to (list sbcl-stumpwm "bin") in their OS configurations, or sbcl-stumpwm instead of sbcl-stumpwm:bin in their profiles. Let me know what you think. Thanks, -- Andy
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Mon, 03 Apr 2017 13:03:02 GMT) Full text and rfc822 format available.Message #8 received at 26346 <at> debbugs.gnu.org (full text, mbox):
From: Andy Patterson <ajpatter <at> uwaterloo.ca> To: 26346 <at> debbugs.gnu.org Cc: Andy Patterson <ajpatter <at> uwaterloo.ca> Subject: [PATCH 01/17] gnu: cl-slynk: Clarify the description. Date: Mon, 3 Apr 2017 09:01:18 -0400
* gnu/packages/lisp.scm (sbcl-slynk-boot0)[description]: Describe slime. --- gnu/packages/lisp.scm | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index 2bbe39807..260b7c9c9 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -4,7 +4,7 @@ ;;; Copyright © 2015 Mark H Weaver <mhw <at> netris.org> ;;; Copyright © 2016 Federico Beffa <beffa <at> fbengineering.ch> ;;; Copyright © 2016, 2017 ng0 <contact.ng0 <at> cryptolab.net> -;;; Copyright © 2016 Andy Patterson <ajpatter <at> uwaterloo.ca> +;;; Copyright © 2016, 2017 Andy Patterson <ajpatter <at> uwaterloo.ca> ;;; Copyright © 2017 Ricardo Wurmus <rekado <at> elephly.net> ;;; ;;; This file is part of GNU Guix. @@ -948,11 +948,11 @@ productive, customizable lisp based systems.") (arguments `(#:tests? #f)) ; No test suite (synopsis "Common Lisp IDE for Emacs") - (description "SLY is a fork of SLIME. It also features a completely -redesigned REPL based on Emacs's own full-featured comint.el, live code -annotations, and a consistent interactive button interface. Everything can be -copied to the REPL. One can create multiple inspectors with independent -history.") + (description "SLY is a fork of SLIME, an IDE backend for Common Lisp. +It also features a completely redesigned REPL based on Emacs's own +full-featured comint.el, live code annotations, and a consistent interactive +button interface. Everything can be copied to the REPL. One can create +multiple inspectors with independent history.") (home-page "https://github.com/joaotavora/sly") (license license:public-domain) (properties `((cl-source-variant . ,(delay cl-slynk))))))) -- 2.11.1
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Mon, 03 Apr 2017 13:03:02 GMT) Full text and rfc822 format available.Message #11 received at 26346 <at> debbugs.gnu.org (full text, mbox):
From: Andy Patterson <ajpatter <at> uwaterloo.ca> To: 26346 <at> debbugs.gnu.org Cc: Andy Patterson <ajpatter <at> uwaterloo.ca> Subject: [PATCH 02/17] gnu: cl-slynk: Explain some naming choices. Date: Mon, 3 Apr 2017 09:01:19 -0400
* gnu/packages/lisp.scm (sbcl-slynk-boot0): Add comments explaining its purpose and the reason its package-name must differ from its name. --- gnu/packages/lisp.scm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index 260b7c9c9..e27cc7b11 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -902,11 +902,15 @@ productive, customizable lisp based systems.") (outputs '("out")) (arguments '())))) +;; The slynk that users expect to install includes all of slynk's contrib +;; modules. Therefore, we build the base module and all contribs first; then +;; we expose the union of these as `sbcl-slynk'. The following variable +;; describes the base module. (define sbcl-slynk-boot0 (let ((revision "1") (commit "5706cd45d484a4f25795abe8e643509d31968aa2")) (package - (name "sbcl-slynk") + (name "sbcl-slynk") ; name must refer to the system name for now (version (string-append "1.0.0-beta-" revision "." (string-take commit 7))) (source (origin -- 2.11.1
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Mon, 03 Apr 2017 13:03:03 GMT) Full text and rfc822 format available.Message #14 received at 26346 <at> debbugs.gnu.org (full text, mbox):
From: Andy Patterson <ajpatter <at> uwaterloo.ca> To: 26346 <at> debbugs.gnu.org Cc: Andy Patterson <ajpatter <at> uwaterloo.ca> Subject: [PATCH 03/17] build-system/asdf: Rename %install-prefix to %source-install-prefix. Date: Mon, 3 Apr 2017 09:01:20 -0400
* guix/build/lisp-utils.scm (%install-prefix): Rename to %source-install-prefix. (build-install-prefix): Use it. * guix/build/asdf-build-system.scm (source-install-prefix) (%system-install-prefix, source-directory, copy-source): Likewise. --- guix/build/asdf-build-system.scm | 10 +++++----- guix/build/lisp-utils.scm | 10 ++++++---- 2 files changed, 11 insertions(+), 9 deletions(-) diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm index 085d073de..c6770c41d 100644 --- a/guix/build/asdf-build-system.scm +++ b/guix/build/asdf-build-system.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016 Andy Patterson <ajpatter <at> uwaterloo.ca> +;;; Copyright © 2016, 2017 Andy Patterson <ajpatter <at> uwaterloo.ca> ;;; ;;; This file is part of GNU Guix. ;;; @@ -43,10 +43,10 @@ (define %object-prefix "/lib") (define (source-install-prefix lisp) - (string-append %install-prefix "/" lisp "-source")) + (string-append %source-install-prefix "/" lisp "-source")) (define %system-install-prefix - (string-append %install-prefix "/systems")) + (string-append %source-install-prefix "/systems")) (define (output-path->package-name path) (package-name->name+version (strip-store-file-name path))) @@ -59,7 +59,7 @@ (string-append output (source-install-prefix lisp) "/" name)) (define (source-directory output name) - (string-append output %install-prefix "/source/" name)) + (string-append output %source-install-prefix "/source/" name)) (define (library-directory output lisp) (string-append output %object-prefix @@ -103,7 +103,7 @@ before any compiling so that the compiled source locations will be valid." "Copy the source to \"out\"." (let* ((out (assoc-ref outputs "out")) (name (remove-lisp-from-name (output-path->package-name out) lisp)) - (install-path (string-append out %install-prefix))) + (install-path (string-append out %source-install-prefix))) (copy-files-to-output outputs "out" name) ;; Hide the files from asdf (with-directory-excursion install-path diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm index 55a07c720..47399bc18 100644 --- a/guix/build/lisp-utils.scm +++ b/guix/build/lisp-utils.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016 Andy Patterson <ajpatter <at> uwaterloo.ca> +;;; Copyright © 2016, 2017 Andy Patterson <ajpatter <at> uwaterloo.ca> ;;; ;;; This file is part of GNU Guix. ;;; @@ -24,7 +24,7 @@ #:use-module (srfi srfi-26) #:use-module (guix build utils) #:export (%lisp - %install-prefix + %source-install-prefix lisp-eval-program compile-system test-system @@ -54,10 +54,12 @@ ;; File name of the Lisp compiler. (make-parameter "lisp")) -(define %install-prefix "/share/common-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 %install-prefix "/" lisp "-bundle-systems")) + (string-append %source-install-prefix "/" lisp "-bundle-systems")) (define (remove-lisp-from-name name lisp) (string-drop name (1+ (string-length lisp)))) -- 2.11.1
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Mon, 03 Apr 2017 13:03:03 GMT) Full text and rfc822 format available.Message #17 received at 26346 <at> debbugs.gnu.org (full text, mbox):
From: Andy Patterson <ajpatter <at> uwaterloo.ca> To: 26346 <at> debbugs.gnu.org Cc: Andy Patterson <ajpatter <at> uwaterloo.ca> Subject: [PATCH 04/17] build-system/asdf: Make it possible to use "lib" as the build output. Date: Mon, 3 Apr 2017 09:01:21 -0400
* guix/build/asdf-build-system.scm (library-output): New variable. (copy-source, build, check, patch-asd-files, symlink-asd-files) (cleanup-files): Use it. (copy-files-to-output): Rework to take an output instead of an outputs and string pair. (install, copy-source): Use the new method. --- guix/build/asdf-build-system.scm | 38 +++++++++++++++++++++----------------- 1 file changed, 21 insertions(+), 17 deletions(-) diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm index c6770c41d..10873e98d 100644 --- a/guix/build/asdf-build-system.scm +++ b/guix/build/asdf-build-system.scm @@ -78,14 +78,18 @@ to it's binary output." (define (source-asd-file output lisp name asd-file) (string-append (lisp-source-directory output lisp name) "/" asd-file)) -(define (copy-files-to-output outputs output name) - "Copy all files from OUTPUT to \"out\". Create an extra link to any -system-defining files in the source to a convenient location. This is done -before any compiling so that the compiled source locations will be valid." - (let* ((out (assoc-ref outputs output)) - (source (getcwd)) - (target (source-directory out name)) - (system-path (string-append out %system-install-prefix))) +(define (library-output outputs) + "If a `lib' output exists, build things there. Otherwise use `out'." + (or (assoc-ref outputs "lib") (assoc-ref outputs "out"))) + +(define (copy-files-to-output out name) + "Copy all files from the current directory to OUT. Create an extra link to +any system-defining files in the source to a convenient location. This is +done before any compiling so that the compiled source locations will be +valid." + (let ((source (getcwd)) + (target (source-directory out name)) + (system-path (string-append out %system-install-prefix))) (copy-recursively source target) (mkdir-p system-path) (for-each @@ -97,14 +101,14 @@ before any compiling so that the compiled source locations will be valid." (define* (install #:key outputs #:allow-other-keys) "Copy and symlink all the source files." - (copy-files-to-output 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) - "Copy the source to \"out\"." - (let* ((out (assoc-ref outputs "out")) + "Copy the source to the library output." + (let* ((out (library-output outputs)) (name (remove-lisp-from-name (output-path->package-name out) lisp)) (install-path (string-append out %source-install-prefix))) - (copy-files-to-output outputs "out" name) + (copy-files-to-output out name) ;; Hide the files from asdf (with-directory-excursion install-path (rename-file "source" (string-append lisp "-source")) @@ -114,7 +118,7 @@ before any compiling so that the compiled source locations will be valid." (define* (build #:key outputs inputs lisp asd-file #:allow-other-keys) "Compile the system." - (let* ((out (assoc-ref outputs "out")) + (let* ((out (library-output outputs)) (name (remove-lisp-from-name (output-path->package-name out) lisp)) (source-path (lisp-source-directory out lisp name)) (translations (wrap-output-translations @@ -148,7 +152,7 @@ before any compiling so that the compiled source locations will be valid." #:allow-other-keys) "Test the system." (let* ((name (remove-lisp-from-name (outputs->name outputs) lisp)) - (out (assoc-ref outputs "out")) + (out (library-output outputs)) (asd-file (and=> asd-file (cut source-asd-file out lisp name <>)))) (if tests? (parameterize ((%lisp (string-append @@ -167,7 +171,7 @@ before any compiling so that the compiled source locations will be valid." find their dependencies. Exclude any TEST-ONLY-SYSTEMS which were only included to run tests. Add any SPECIAL-DEPENDENCIES which the LISP implementation itself provides." - (let* ((out (assoc-ref outputs "out")) + (let* ((out (library-output outputs)) (name (remove-lisp-from-name (output-path->package-name out) lisp)) (registry (lset-difference (lambda (input system) @@ -186,7 +190,7 @@ implementation itself provides." (define* (symlink-asd-files #:key outputs lisp #:allow-other-keys) "Create an extra reference to the system in a convenient location." - (let* ((out (assoc-ref outputs "out"))) + (let* ((out (library-output outputs))) (for-each (lambda (asd-file) (substitute* asd-file @@ -208,7 +212,7 @@ implementation itself provides." (define* (cleanup-files #:key outputs lisp #:allow-other-keys) "Remove any compiled files which are not a part of the final bundle." - (let ((out (assoc-ref outputs "out"))) + (let ((out (library-output outputs))) (match lisp ("sbcl" (for-each -- 2.11.1
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Mon, 03 Apr 2017 13:03:04 GMT) Full text and rfc822 format available.Message #20 received at 26346 <at> debbugs.gnu.org (full text, mbox):
From: Andy Patterson <ajpatter <at> uwaterloo.ca> To: 26346 <at> debbugs.gnu.org Cc: Andy Patterson <ajpatter <at> uwaterloo.ca> Subject: [PATCH 05/17] gnu: cl-stumpwm: Build the library in "lib" and the program in "bin". Date: Mon, 3 Apr 2017 09:01:22 -0400
* gnu/packages/lisp.scm (sbcl-stumpwm)[outputs]: Remove "bin" and add "lib". [arguments]<#:phases>: Change the target of `build-program' to the "out" output. Likewise, change the target of the desktop file generation. (sbcl-stumpwm+slynk)[inputs]: Use the "lib" output of sbcl-stumpwm. --- gnu/packages/lisp.scm | 28 +++++++++++++--------------- 1 file changed, 13 insertions(+), 15 deletions(-) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index e27cc7b11..5502de86a 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -851,7 +851,7 @@ from other CLXes around the net.") (build-system asdf-build-system/sbcl) (inputs `(("sbcl-cl-ppcre" ,sbcl-cl-ppcre) ("sbcl-clx" ,sbcl-clx))) - (outputs '("out" "bin")) + (outputs '("out" "lib")) (arguments '(#:special-dependencies '("sb-posix") #:phases @@ -860,20 +860,18 @@ from other CLXes around the net.") (lambda* (#:key lisp outputs inputs #:allow-other-keys) (build-program lisp - (string-append (assoc-ref outputs "bin") "/bin/stumpwm") + (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 lisp binary? #:allow-other-keys) - (let ((output (or (assoc-ref outputs "bin") - (assoc-ref outputs "out"))) - (xsessions "/share/xsessions")) - (mkdir-p (string-append output xsessions)) - (with-output-to-file - (string-append output xsessions - "/stumpwm.desktop") - (lambda _ - (format #t + (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (xsessions (string-append out "/share/xsessions"))) + (mkdir-p xsessions) + (call-with-output-file + (string-append xsessions "/stumpwm.desktop") + (lambda (file) + (format file "[Desktop Entry]~@ Name=stumpwm~@ Comment=The Stump Window Manager~@ @@ -881,7 +879,7 @@ from other CLXes around the net.") TryExec=~@*~a/bin/stumpwm~@ Icon=~@ Type=Application~%" - output))) + out))) #t)))))) (synopsis "Window manager written in Common Lisp") (description "Stumpwm is a window manager written entirely in Common Lisp. @@ -1141,7 +1139,7 @@ multiple inspectors with independent history.") (name "sbcl-stumpwm-with-slynk") (outputs '("out")) (native-inputs - `(("stumpwm" ,sbcl-stumpwm) + `(("stumpwm" ,sbcl-stumpwm "lib") ("slynk" ,sbcl-slynk))) (arguments (substitute-keyword-arguments (package-arguments sbcl-stumpwm) @@ -1162,6 +1160,6 @@ multiple inspectors with independent history.") (delete 'copy-source) (delete 'build) (delete 'check) - (delete 'link-dependencies) + (delete 'create-asd-file) (delete 'cleanup) (delete 'create-symlinks))))))) -- 2.11.1
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Mon, 03 Apr 2017 13:03:04 GMT) Full text and rfc822 format available.Message #23 received at 26346 <at> debbugs.gnu.org (full text, mbox):
From: Andy Patterson <ajpatter <at> uwaterloo.ca> To: 26346 <at> debbugs.gnu.org Cc: Andy Patterson <ajpatter <at> uwaterloo.ca> Subject: [PATCH 06/17] build-system/asdf: Use asdf to determine dependencies. Date: Mon, 3 Apr 2017 09:01:23 -0400
This removes the need for conventions to determine which inputs are run-time dependencies, and also the need to specify "special" dependencies. * guix/build/lisp-utils.scm (patch-asd-file, lisp-dependencies) (wrap-perform-method): Remove them. (inputs->asd-file-map, system-dependencies, generate-system-definition) (generate-dependency-links, make-asd-file): New variables. (lisp-eval-program): Add an error if no lisp matches. (compile-system): Don't use asdf's in-built asd-file generator. --- gnu/packages/lisp.scm | 5 +- guix/build-system/asdf.scm | 7 +- guix/build/asdf-build-system.scm | 51 +++++------ guix/build/lisp-utils.scm | 185 ++++++++++++++++++++++++++------------- 4 files changed, 145 insertions(+), 103 deletions(-) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index 5502de86a..183e37b92 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -820,8 +820,6 @@ compatible with ANSI-compliant Common Lisp implementations.") (substitute* "clx.asd" (("\\(:file \"trapezoid\"\\)") "")))))) (build-system asdf-build-system/sbcl) - (arguments - '(#:special-dependencies '("sb-bsd-sockets"))) (home-page "http://www.cliki.net/portable-clx") (synopsis "X11 client library for Common Lisp") (description "CLX is an X11 client library for Common Lisp. The code was @@ -853,8 +851,7 @@ from other CLXes around the net.") ("sbcl-clx" ,sbcl-clx))) (outputs '("out" "lib")) (arguments - '(#:special-dependencies '("sb-posix") - #:phases + '(#:phases (modify-phases %standard-phases (add-after 'create-symlinks 'build-program (lambda* (#:key lisp outputs inputs #:allow-other-keys) diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm index f28c098ea..4b5af95c9 100644 --- a/guix/build-system/asdf.scm +++ b/guix/build-system/asdf.scm @@ -194,8 +194,7 @@ set up using CL source package conventions." (define base-arguments (if target-is-source? (strip-keyword-arguments - '(#:tests? #:special-dependencies #:asd-file - #:test-only-systems #:lisp) + '(#:tests? #:asd-file #:lisp) (package-arguments pkg)) (package-arguments pkg))) @@ -262,9 +261,7 @@ set up using CL source package conventions." (lambda* (store name inputs #:key source outputs (tests? #t) - (special-dependencies ''()) (asd-file #f) - (test-only-systems ''()) (lisp lisp-implementation) (phases '(@ (guix build asdf-build-system) %standard-phases)) @@ -284,9 +281,7 @@ set up using CL source package conventions." ((source) source) (source source)) #:lisp ,lisp - #:special-dependencies ,special-dependencies #:asd-file ,asd-file - #:test-only-systems ,test-only-systems #:system ,system #:tests? ,tests? #:phases ,phases diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm index 10873e98d..a16f11965 100644 --- a/guix/build/asdf-build-system.scm +++ b/guix/build/asdf-build-system.scm @@ -21,6 +21,7 @@ #:use-module (guix build utils) #:use-module (guix build lisp-utils) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (ice-9 rdelim) #:use-module (ice-9 receive) @@ -161,31 +162,25 @@ valid." (format #t "test suite not run~%"))) #t) -(define* (patch-asd-files #:key outputs +(define* (create-asd-file #:key outputs inputs lisp - special-dependencies - test-only-systems + asd-file #:allow-other-keys) - "Patch any asd files created by the compilation process so that they can -find their dependencies. Exclude any TEST-ONLY-SYSTEMS which were only -included to run tests. Add any SPECIAL-DEPENDENCIES which the LISP -implementation itself provides." - (let* ((out (library-output outputs)) - (name (remove-lisp-from-name (output-path->package-name out) lisp)) - (registry (lset-difference - (lambda (input system) - (match input - ((name . path) (string=? name system)))) - (lisp-dependencies lisp inputs) - test-only-systems)) - (lisp-systems (map first registry))) - - (for-each - (lambda (asd-file) - (patch-asd-file asd-file registry lisp - (append lisp-systems special-dependencies))) - (find-files out "\\.asd$"))) + "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)) + ((new-asd-file) (string-append (library-directory out lisp) + "/" name ".asd"))) + + (make-asd-file new-asd-file + #:lisp lisp + #:system name + #:version version + #:inputs inputs + #:system-asd-file asd-file)) #t) (define* (symlink-asd-files #:key outputs lisp #:allow-other-keys) @@ -193,9 +188,6 @@ implementation itself provides." (let* ((out (library-output outputs))) (for-each (lambda (asd-file) - (substitute* asd-file - ((";;; Built for.*") "") ; remove potential non-determinism - (("^\\(DEFSYSTEM(.*)$" all end) (string-append "(asdf:defsystem" end))) (receive (new-asd-file asd-file-directory) (bundle-asd-file out asd-file lisp) (mkdir-p asd-file-directory) @@ -205,12 +197,11 @@ implementation itself provides." (prepend-to-source-registry (string-append asd-file-directory "/")))) - (find-files (string-append out %object-prefix) "\\.asd$")) -) + (find-files (string-append out %object-prefix) "\\.asd$"))) #t) (define* (cleanup-files #:key outputs lisp - #:allow-other-keys) + #:allow-other-keys) "Remove any compiled files which are not a part of the final bundle." (let ((out (library-output outputs))) (match lisp @@ -261,8 +252,8 @@ implementation itself provides." (add-before 'build 'copy-source copy-source) (replace 'check check) (replace 'strip strip) - (add-after 'check 'link-dependencies patch-asd-files) - (add-after 'link-dependencies 'cleanup cleanup-files) + (add-after 'check 'create-asd-file create-asd-file) + (add-after 'create-asd-file 'cleanup cleanup-files) (add-after 'cleanup 'create-symlinks symlink-asd-files))) (define* (asdf-build #:key inputs diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm index 47399bc18..4f1565b55 100644 --- a/guix/build/lisp-utils.scm +++ b/guix/build/lisp-utils.scm @@ -18,6 +18,7 @@ (define-module (guix build lisp-utils) #:use-module (ice-9 format) + #:use-module (ice-9 hash-table) #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (srfi srfi-1) @@ -32,15 +33,14 @@ generate-executable-wrapper-system generate-executable-entry-point generate-executable-for-system - patch-asd-file bundle-install-prefix - lisp-dependencies bundle-asd-file remove-lisp-from-name wrap-output-translations prepend-to-source-registry build-program - build-image)) + build-image + make-asd-file)) ;;; Commentary: ;;; @@ -64,6 +64,23 @@ (define (remove-lisp-from-name name lisp) (string-drop name (1+ (string-length lisp)))) +(define (inputs->asd-file-map inputs lisp) + "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)))) + (and (directory-exists? prefix) + (match (find-files prefix "\\.asd$") + ((asd-file) + (cons + (string-drop-right (basename asd-file) 4) ; drop ".asd" + asd-file)) + (_ #f)))))) + inputs))) + (define (wrap-output-translations translations) `(:output-translations ,@translations @@ -80,7 +97,8 @@ with PROGRAM." (match lisp ("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.")))) (define (asdf-load-all systems) (map (lambda (system) @@ -108,15 +126,61 @@ first if SYSTEM is defined there." (find-symbol (symbol-name :compile-bundle-op) (symbol-name :asdf)) - ,system) - (funcall (find-symbol - (symbol-name :operate) - (symbol-name :asdf)) - (find-symbol - (symbol-name :deliver-asd-op) - (symbol-name :asdf)) ,system)))) +(define (system-dependencies lisp 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") + (define program + `(progn + (require :asdf) + ,@(if asd-file + `((let ((*package* (find-package :asdf))) + (load ,asd-file))) + '()) + (with-open-file + (stream ,deps-file :direction :output) + (format stream + "~s~%" + (funcall + (find-symbol + (symbol-name :system-depends-on) + (symbol-name :asdf)) + + (funcall + (find-symbol + (symbol-name :find-system) + (symbol-name :asdf)) + + ,system)))))) + + (dynamic-wind + (lambda _ + (lisp-eval-program lisp 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 + ("sbcl" (string-append system "--system")) + (_ system))) + +(define* (generate-system-definition lisp 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) + `(:lib ,(string-append system ".a")) + '()))) + (define (test-system system lisp asd-file) "Use a lisp implementation to test SYSTEM using asdf. Load ASD-FILE first if SYSTEM is defined there." @@ -185,58 +249,53 @@ ENTRY-PROGRAM for SYSTEM within the current directory." (declare (ignorable arguments)) ,@entry-program)))))))) -(define (wrap-perform-method lisp registry dependencies file-name) - "Creates a wrapper method which allows the system to locate its dependent -systems from REGISTRY, an alist of the same form as %outputs, which contains -lisp systems which the systems is dependent on. All DEPENDENCIES which the -system depends on will the be loaded before this system." - (let* ((system (string-drop-right (basename file-name) 4)) - (system-symbol (string->lisp-keyword system))) - - `(defmethod asdf:perform :before - (op (c (eql (asdf:find-system ,system-symbol)))) - (asdf/source-registry:ensure-source-registry) - ,@(map (match-lambda - ((name . path) - (let ((asd-file (string-append path - (bundle-install-prefix lisp) - "/" name ".asd"))) - `(setf - (gethash ,name - asdf/source-registry:*source-registry*) - ,(string->symbol "#p") - ,(bundle-asd-file path asd-file lisp))))) - registry) - ,@(map (lambda (system) - `(asdf:load-system ,(string->lisp-keyword system))) - dependencies)))) - -(define (patch-asd-file asd-file registry lisp dependencies) - "Patches ASD-FILE with a perform method as described in WRAP-PERFORM-METHOD." - (chmod asd-file #o644) - (let ((port (open-file asd-file "a"))) - (dynamic-wind - (lambda _ #t) - (lambda _ - (display - (replace-escaped-macros - (format #f "~%~y~%" - (wrap-perform-method lisp registry - dependencies asd-file))) - port)) - (lambda _ (close-port port)))) - (chmod asd-file #o444)) - -(define (lisp-dependencies lisp inputs) - "Determine which inputs are lisp system dependencies, by using the convention -that a lisp system dependency will resemble \"system-LISP\"." - (filter-map (match-lambda - ((name . value) - (and (string-prefix? lisp name) - (string<> lisp name) - `(,(remove-lisp-from-name name lisp) - . ,value)))) - inputs)) +(define (generate-dependency-links lisp 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." + `(progn + (asdf/source-registry:ensure-source-registry) + ,@(map (match-lambda + ((name . asd-file) + `(setf + (gethash ,name + asdf/source-registry:*source-registry*) + ,(string->symbol "#p") + ,asd-file))) + registry))) + +(define* (make-asd-file asd-file + #:key lisp system version inputs + (system-asd-file #f)) + "Create an ASD-FILE for SYSTEM <at> 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))) + + (define lisp-input-map + (inputs->asd-file-map inputs lisp)) + + (define registry + (filter-map hash-get-handle + (make-list (if (eq? 'NIL dependencies) + 0 + (length dependencies)) + lisp-input-map) + (if (eq? 'NIL dependencies) + '() + dependencies))) + + (call-with-output-file asd-file + (lambda (port) + (display + (replace-escaped-macros + (format #f "~y~%~y~%" + (generate-system-definition lisp system + #:version version + #:dependencies dependencies) + (generate-dependency-links lisp registry system))) + port)))) (define (bundle-asd-file output-path original-asd-file lisp) "Find the symlinked bundle file for ORIGINAL-ASD-FILE by looking in -- 2.11.1
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Mon, 03 Apr 2017 13:03:05 GMT) Full text and rfc822 format available.Message #26 received at 26346 <at> debbugs.gnu.org (full text, mbox):
From: Andy Patterson <ajpatter <at> uwaterloo.ca> To: 26346 <at> debbugs.gnu.org Cc: Andy Patterson <ajpatter <at> uwaterloo.ca> Subject: [PATCH 07/17] build-system/asdf: Don't rename inputs. Date: Mon, 3 Apr 2017 09:01:24 -0400
* guix/build-system/asdf.scm (package-with-build-system)[transform]: Use updated `new-inputs' prodcedure for inputs and native-inputs. <rewrite>: Don't rename inputs. <new-propagated-inputs>: Draw from package-inputs and package-native-inputs for source packages. Use the original package's propagated-inputs otherwise. <new-inputs>: Convert into a function to be used to transform inputs and native-inputs. * gnu/packages/lisp.scm (sbcl-fiveam, sbcl-bordeaux-threads) (sbcl-flexi-streams, sbcl-cl-ppcre, sbcl-stumpwm, sbcl-slynk-arglists) (sbcl-slynk-fancy-inspector): Don't prefix input names. --- gnu/packages/lisp.scm | 18 +++++++++--------- guix/build-system/asdf.scm | 44 ++++++++++++++++++++++---------------------- 2 files changed, 31 insertions(+), 31 deletions(-) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index 183e37b92..863b35cea 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -657,7 +657,7 @@ portable between implementations.") (sha256 (base32 "0f48pcbhqs3wwwzjl5nk57d4hcbib4l9xblxc66b8c2fhvhmhxnv")) (file-name (string-append "fiveam-" version ".tar.gz")))) - (inputs `(("sbcl-alexandria" ,sbcl-alexandria))) + (inputs `(("alexandria" ,sbcl-alexandria))) (build-system asdf-build-system/sbcl) (synopsis "Common Lisp testing framework") (description "FiveAM is a simple (as far as writing and running tests @@ -685,8 +685,8 @@ interactive development model in mind.") (base32 "10ryrcx832fwqdawb6jmknymi7wpdzhi30qzx7cbrk0cpnka71w2")) (file-name (string-append "bordeaux-threads-" version ".tar.gz")))) - (inputs `(("sbcl-alexandria" ,sbcl-alexandria))) - (native-inputs `(("tests:cl-fiveam" ,sbcl-fiveam))) + (inputs `(("alexandria" ,sbcl-alexandria))) + (native-inputs `(("fiveam" ,sbcl-fiveam))) (build-system asdf-build-system/sbcl) (synopsis "Portable shared-state concurrency library for Common Lisp") (description "BORDEAUX-THREADS is a proposed standard for a minimal @@ -747,7 +747,7 @@ thin compatibility layer for gray streams.") (base32 "16grnxvs7vqm5s6myf8a5s7vwblzq1kgwj8i7ahz8vwvihm9gzfi")) (file-name (string-append "flexi-streams-" version ".tar.gz")))) (build-system asdf-build-system/sbcl) - (inputs `(("sbcl-trivial-gray-streams" ,sbcl-trivial-gray-streams))) + (inputs `(("trivial-gray-streams" ,sbcl-trivial-gray-streams))) (synopsis "Implementation of virtual bivalent streams for Common Lisp") (description "Flexi-streams is an implementation of \"virtual\" bivalent streams that can be layered atop real binary or bivalent streams and that can @@ -777,7 +777,7 @@ streams which are similar to string streams.") (base32 "1i7daxf0wnydb0pgwiym7qh2wy70n14lxd6dyv28sy0naa8p31gd")) (file-name (string-append "cl-ppcre-" version ".tar.gz")))) (build-system asdf-build-system/sbcl) - (native-inputs `(("tests:cl-flexi-streams" ,sbcl-flexi-streams))) + (native-inputs `(("flexi-streams" ,sbcl-flexi-streams))) (synopsis "Portable regular expression library for Common Lisp") (description "CL-PPCRE is a portable regular expression library for Common Lisp, which is compatible with perl. It is pretty fast, thread-safe, and @@ -847,8 +847,8 @@ from other CLXes around the net.") (base32 "1maxp98gh64az3d9vz9br6zdd6rc9fmj2imvax4by85g6kxvdz1i")) (file-name (string-append "stumpwm-" version ".tar.gz")))) (build-system asdf-build-system/sbcl) - (inputs `(("sbcl-cl-ppcre" ,sbcl-cl-ppcre) - ("sbcl-clx" ,sbcl-clx))) + (inputs `(("cl-ppcre" ,sbcl-cl-ppcre) + ("clx" ,sbcl-clx))) (outputs '("out" "lib")) (arguments '(#:phases @@ -966,7 +966,7 @@ multiple inspectors with independent history.") (package (inherit sbcl-slynk-boot0) (name "sbcl-slynk-arglists") - (inputs `(("sbcl-slynk" ,sbcl-slynk-boot0))) + (inputs `(("slynk" ,sbcl-slynk-boot0))) (arguments `(#:asd-file "slynk.asd" ,@(package-arguments sbcl-slynk-boot0))))) @@ -986,7 +986,7 @@ multiple inspectors with independent history.") (package (inherit sbcl-slynk-arglists) (name "sbcl-slynk-fancy-inspector") - (inputs `(("sbcl-slynk-util" ,sbcl-slynk-util) + (inputs `(("slynk-util" ,sbcl-slynk-util) ,@(package-inputs sbcl-slynk-arglists))))) (define ecl-slynk-fancy-inspector diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm index 4b5af95c9..d02565b2d 100644 --- a/guix/build-system/asdf.scm +++ b/guix/build-system/asdf.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016 Andy Patterson <ajpatter <at> uwaterloo.ca> +;;; Copyright © 2016, 2017 Andy Patterson <ajpatter <at> uwaterloo.ca> ;;; ;;; This file is part of GNU Guix. ;;; @@ -163,33 +163,35 @@ set up using CL source package conventions." (match-lambda ((name content . rest) (let* ((is-package? (package? content)) - (new-content (if is-package? (transform content) content)) - (new-name (if (and is-package? - (string-prefix? from-prefix name)) - (package-name new-content) - name))) - `(,new-name ,new-content ,@rest))))) + (new-content (if is-package? (transform content) content))) + `(,name ,new-content ,@rest))))) ;; Special considerations for source packages: CL inputs become - ;; propagated, and un-handled arguments are removed. Native inputs are - ;; removed as are extraneous outputs. + ;; propagated, and un-handled arguments are removed. + (define new-propagated-inputs (if target-is-source? (map rewrite - (filter (match-lambda - ((_ input . _) - (has-from-build-system? input))) - (package-inputs pkg))) - '())) - - (define new-inputs + (append + (filter (match-lambda + ((_ input . _) + (has-from-build-system? input))) + (append (package-inputs pkg) + ;; The native inputs might be needed just + ;; to load the system. + (package-native-inputs pkg))) + (package-propagated-inputs pkg))) + + (map rewrite (package-propagated-inputs pkg)))) + + (define (new-inputs inputs-getter) (if target-is-source? (map rewrite (filter (match-lambda ((_ input . _) (not (has-from-build-system? input)))) - (package-inputs pkg))) - (map rewrite (package-inputs pkg)))) + (inputs-getter pkg))) + (map rewrite (inputs-getter pkg)))) (define base-arguments (if target-is-source? @@ -212,11 +214,9 @@ set up using CL source package conventions." (arguments (substitute-keyword-arguments base-arguments ((#:phases phases) (list phases-transformer phases)))) - (inputs new-inputs) + (inputs (new-inputs package-inputs)) (propagated-inputs new-propagated-inputs) - (native-inputs (if target-is-source? - '() - (map rewrite (package-native-inputs pkg)))) + (native-inputs (new-inputs package-native-inputs)) (outputs (if target-is-source? '("out") (package-outputs pkg))))) -- 2.11.1
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Mon, 03 Apr 2017 13:03:05 GMT) Full text and rfc822 format available.Message #29 received at 26346 <at> debbugs.gnu.org (full text, mbox):
From: Andy Patterson <ajpatter <at> uwaterloo.ca> To: 26346 <at> debbugs.gnu.org Cc: Andy Patterson <ajpatter <at> uwaterloo.ca> Subject: [PATCH 08/17] build-system/asdf: Keep ecl's generated archive files. Date: Mon, 3 Apr 2017 09:01:25 -0400
This may be necessary to produce programs or images with ecl. * guix/build/asdf-build-system.scm (cleanup-files): Don't delete .a files. --- guix/build/asdf-build-system.scm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm index a16f11965..2efd16430 100644 --- a/guix/build/asdf-build-system.scm +++ b/guix/build/asdf-build-system.scm @@ -214,8 +214,7 @@ valid." ("ecl" (for-each delete-file (append (find-files out "\\.fas$") - (find-files out "\\.o$") - (find-files out "\\.a$"))))) + (find-files out "\\.o$"))))) (with-directory-excursion (library-directory out lisp) (for-each -- 2.11.1
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Mon, 03 Apr 2017 13:03:06 GMT) Full text and rfc822 format available.Message #32 received at 26346 <at> debbugs.gnu.org (full text, mbox):
From: Andy Patterson <ajpatter <at> uwaterloo.ca> To: 26346 <at> debbugs.gnu.org Cc: Andy Patterson <ajpatter <at> uwaterloo.ca> Subject: [PATCH 09/17] build-system/asdf: Make #:lisp a package argument. Date: Mon, 3 Apr 2017 09:01:26 -0400
* 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. --- gnu/packages/lisp.scm | 8 +++--- guix/build-system/asdf.scm | 13 +++++----- guix/build/asdf-build-system.scm | 56 +++++++++++++++++++++------------------- 3 files changed, 40 insertions(+), 37 deletions(-) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index 863b35cea..227d81845 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -854,9 +854,9 @@ from other CLXes around the net.") '(#:phases (modify-phases %standard-phases (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 - lisp + lisp-type (string-append (assoc-ref outputs "out") "/bin/stumpwm") #:inputs inputs #:entry-program '((stumpwm:stumpwm) 0)))) @@ -1143,10 +1143,10 @@ multiple inspectors with independent history.") ((#:phases phases) `(modify-phases ,phases (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")) (program (string-append out "/bin/stumpwm"))) - (build-program lisp program + (build-program lisp-type program #:inputs inputs #:entry-program '((stumpwm:stumpwm) 0) #:dependencies '("stumpwm" diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm index d02565b2d..1ef6f32d4 100644 --- a/guix/build-system/asdf.scm +++ b/guix/build-system/asdf.scm @@ -232,10 +232,10 @@ set up using CL source package conventions." (properties (alist-delete variant properties))) pkg)) -(define (lower lisp-implementation) +(define (lower lisp-type) (lambda* (name #: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 #:rest arguments) "Return a bag for NAME" @@ -251,18 +251,17 @@ set up using CL source package conventions." '()) ,@inputs ,@(standard-packages))) - (build-inputs `((,lisp-implementation ,lisp) + (build-inputs `((,lisp-type ,lisp) ,@native-inputs)) (outputs outputs) - (build (asdf-build lisp-implementation)) + (build (asdf-build lisp-type)) (arguments (strip-keyword-arguments private-keywords arguments)))))) -(define (asdf-build lisp-implementation) +(define (asdf-build lisp-type) (lambda* (store name inputs #:key source outputs (tests? #t) (asd-file #f) - (lisp lisp-implementation) (phases '(@ (guix build asdf-build-system) %standard-phases)) (search-paths '()) @@ -280,7 +279,7 @@ set up using CL source package conventions." (derivation->output-path source)) ((source) source) (source source)) - #:lisp ,lisp + #:lisp-type ,lisp-type #:asd-file ,asd-file #:system ,system #:tests? ,tests? diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm index 2efd16430..c5f2c080d 100644 --- a/guix/build/asdf-build-system.scm +++ b/guix/build/asdf-build-system.scm @@ -104,29 +104,32 @@ 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 #:allow-other-keys) +(define* (copy-source #:key outputs lisp-type #: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)) + (name (remove-lisp-from-name (output-path->package-name out) + lisp-type)) (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 "-source")) + (rename-file "source" (string-append lisp-type "-source")) (delete-file-recursively "systems"))) #t) -(define* (build #:key outputs inputs lisp asd-file +(define* (build #:key outputs inputs lisp-type asd-file #:allow-other-keys) "Compile the system." (let* ((out (library-output outputs)) - (name (remove-lisp-from-name (output-path->package-name out) lisp)) - (source-path (lisp-source-directory out lisp name)) + (name (remove-lisp-from-name (output-path->package-name out) + lisp-type)) + (source-path (lisp-source-directory out lisp-type name)) (translations (wrap-output-translations `(,(output-translation source-path out - lisp)))) - (asd-file (and=> asd-file (cut source-asd-file out lisp name <>)))) + lisp-type)))) + (asd-file (and=> asd-file + (cut source-asd-file out lisp-type name <>)))) (setenv "ASDF_OUTPUT_TRANSLATIONS" (replace-escaped-macros (format #f "~S" translations))) @@ -139,8 +142,8 @@ valid." (setenv "HOME" out) ; ecl's asdf sometimes wants to create $HOME/.cache (parameterize ((%lisp (string-append - (assoc-ref inputs lisp) "/bin/" lisp))) - (compile-system name lisp 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 @@ -149,47 +152,48 @@ valid." (delete-file-recursively cache-directory)))) #t) -(define* (check #:key lisp tests? outputs inputs asd-file +(define* (check #:key lisp-type tests? outputs inputs asd-file #:allow-other-keys) "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)) - (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? (parameterize ((%lisp (string-append - (assoc-ref inputs lisp) "/bin/" lisp))) - (test-system name lisp asd-file)) + (assoc-ref inputs lisp-type) "/bin/" lisp-type))) + (test-system name lisp-type asd-file)) (format #t "test suite not run~%"))) #t) (define* (create-asd-file #:key outputs inputs - lisp + 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)) - ((new-asd-file) (string-append (library-directory out lisp) + ((name) (remove-lisp-from-name full-name lisp-type)) + ((new-asd-file) (string-append (library-directory out lisp-type) "/" name ".asd"))) (make-asd-file new-asd-file - #:lisp lisp + #:lisp lisp-type #:system name #:version version #:inputs inputs #:system-asd-file asd-file)) #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." (let* ((out (library-output outputs))) (for-each (lambda (asd-file) (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) (symlink asd-file new-asd-file) ;; Update the source registry for future phases which might want to @@ -200,11 +204,11 @@ valid." (find-files (string-append out %object-prefix) "\\.asd$"))) #t) -(define* (cleanup-files #:key outputs lisp +(define* (cleanup-files #:key outputs lisp-type #:allow-other-keys) "Remove any compiled files which are not a part of the final bundle." (let ((out (library-output outputs))) - (match lisp + (match lisp-type ("sbcl" (for-each (lambda (file) @@ -216,7 +220,7 @@ valid." (append (find-files out "\\.fas$") (find-files out "\\.o$"))))) - (with-directory-excursion (library-directory out lisp) + (with-directory-excursion (library-directory out lisp-type) (for-each (lambda (file) (rename-file file @@ -231,9 +235,9 @@ valid." (string<> ".." file))))))) #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 - (or (string=? lisp "sbcl") + (or (string=? lisp-type "sbcl") (apply (assoc-ref gnu:%standard-phases 'strip) args))) (define %standard-phases/source -- 2.11.1
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Mon, 03 Apr 2017 13:03:06 GMT) Full text and rfc822 format available.Message #35 received at 26346 <at> debbugs.gnu.org (full text, mbox):
From: Andy Patterson <ajpatter <at> uwaterloo.ca> To: 26346 <at> debbugs.gnu.org Cc: Andy Patterson <ajpatter <at> uwaterloo.ca> Subject: [PATCH 11/17] build-system/asdf: Pass the system name as an argument to the builder. Date: Mon, 3 Apr 2017 09:01:28 -0400
* guix/build-system/asdf.scm (asdf-build): Use the user-defined system name, or calculate it from the package's full name. [builder]: Pass the value along to the build procedure. (package-with-build-system): Remove #:asd-system-name from source packages' arguments. * guix/build/asdf-build-system.scm: Adjust accordingly. * guix/build/lisp-utils.scm (remove-lisp-from-name): Delete variable. --- guix/build-system/asdf.scm | 14 ++++++++++++- guix/build/asdf-build-system.scm | 44 ++++++++++++++++------------------------ guix/build/lisp-utils.scm | 4 ---- 3 files changed, 30 insertions(+), 32 deletions(-) diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm index 4afc6ef1a..ab571c9b4 100644 --- a/guix/build-system/asdf.scm +++ b/guix/build-system/asdf.scm @@ -22,6 +22,9 @@ #:use-module (guix packages) #:use-module (guix derivations) #:use-module (guix search-paths) + #:use-module ((guix build utils) + #:select ((package-name->name+version + . hyphen-separated-name->name+version))) #:use-module (guix build-system) #:use-module (guix build-system gnu) #:use-module (ice-9 match) @@ -196,7 +199,7 @@ set up using CL source package conventions." (define base-arguments (if target-is-source? (strip-keyword-arguments - '(#:tests? #:asd-file #:lisp) + '(#:tests? #:asd-file #:lisp #:asd-system-name) (package-arguments pkg)) (package-arguments pkg))) @@ -262,6 +265,7 @@ set up using CL source package conventions." #:key source outputs (tests? #t) (asd-file #f) + (asd-system-name #f) (phases '(@ (guix build asdf-build-system) %standard-phases)) (search-paths '()) @@ -270,6 +274,13 @@ set up using CL source package conventions." (imported-modules %asdf-build-system-modules) (modules %asdf-build-modules)) + (define system-name + (or asd-system-name + (string-drop + ;; NAME is the value returned from `package-full-name'. + (hyphen-separated-name->name+version name) + (1+ (string-length lisp-type))))) ; drop the "<lisp>-" prefixa + (define builder `(begin (use-modules ,@modules) @@ -284,6 +295,7 @@ set up using CL source package conventions." ((source) source) (source source)) #:asd-file ,asd-file + #:asd-system-name ,system-name #:system ,system #:tests? ,tests? #:phases ,phases diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm index 4305a86af..0fe01bd6b 100644 --- a/guix/build/asdf-build-system.scm +++ b/guix/build/asdf-build-system.scm @@ -49,13 +49,6 @@ (define %system-install-prefix (string-append %source-install-prefix "/systems")) -(define (output-path->package-name path) - (package-name->name+version (strip-store-file-name path))) - -(define (outputs->name outputs) - (output-path->package-name - (assoc-ref outputs "out"))) - (define (lisp-source-directory output name) (string-append output (%lisp-source-install-prefix) "/" name)) @@ -99,33 +92,31 @@ valid." (find-files target "\\.asd$")) #t)) -(define* (install #:key outputs #:allow-other-keys) +(define* (install #:key outputs asd-system-name #:allow-other-keys) "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") asd-system-name)) -(define* (copy-source #:key outputs #:allow-other-keys) +(define* (copy-source #:key outputs asd-system-name #: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))) (install-path (string-append out %source-install-prefix))) - (copy-files-to-output out name) + (copy-files-to-output out asd-system-name) ;; Hide the files from asdf (with-directory-excursion install-path (rename-file "source" (string-append (%lisp-type) "-source")) (delete-file-recursively "systems"))) #t) -(define* (build #:key outputs inputs asd-file +(define* (build #:key outputs inputs asd-file asd-system-name #:allow-other-keys) "Compile the system." (let* ((out (library-output outputs)) - (name (remove-lisp-from-name (output-path->package-name out))) - (source-path (lisp-source-directory out name)) + (source-path (lisp-source-directory out asd-system-name)) (translations (wrap-output-translations `(,(output-translation source-path out)))) (asd-file (and=> asd-file - (cut source-asd-file out name <>)))) + (cut source-asd-file out asd-system-name <>)))) (setenv "ASDF_OUTPUT_TRANSLATIONS" (replace-escaped-macros (format #f "~S" translations))) @@ -137,7 +128,7 @@ valid." (setenv "HOME" out) ; ecl's asdf sometimes wants to create $HOME/.cache - (compile-system name asd-file) + (compile-system asd-system-name asd-file) ;; As above, ecl will sometimes create this even though it doesn't use it @@ -146,32 +137,31 @@ valid." (delete-file-recursively cache-directory)))) #t) -(define* (check #:key tests? outputs inputs asd-file +(define* (check #:key tests? outputs inputs asd-file asd-system-name #:allow-other-keys) "Test the system." - (let* ((name (remove-lisp-from-name (outputs->name outputs))) - (out (library-output outputs)) + (let* ((out (library-output outputs)) (asd-file (and=> asd-file - (cut source-asd-file out name <>)))) + (cut source-asd-file out asd-system-name <>)))) (if tests? - (test-system name asd-file) + (test-system asd-system-name asd-file) (format #t "test suite not run~%"))) #t) (define* (create-asd-file #:key outputs inputs asd-file + asd-system-name #: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)) + ((_ version) (package-name->name+version + (strip-store-file-name out))) ((new-asd-file) (string-append (library-directory out) - "/" name ".asd"))) + "/" asd-system-name ".asd"))) (make-asd-file new-asd-file - #:system name + #:system asd-system-name #:version version #:inputs inputs #:system-asd-file asd-file)) diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm index 148357bf0..2d730570a 100644 --- a/guix/build/lisp-utils.scm +++ b/guix/build/lisp-utils.scm @@ -36,7 +36,6 @@ generate-executable-for-system %bundle-install-prefix bundle-asd-file - remove-lisp-from-name wrap-output-translations prepend-to-source-registry build-program @@ -66,9 +65,6 @@ (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) "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." -- 2.11.1
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Mon, 03 Apr 2017 13:03:06 GMT) Full text and rfc822 format available.Message #38 received at 26346 <at> debbugs.gnu.org (full text, mbox):
From: Andy Patterson <ajpatter <at> uwaterloo.ca> To: 26346 <at> debbugs.gnu.org Cc: Andy Patterson <ajpatter <at> uwaterloo.ca> Subject: [PATCH 10/17] build-system/asdf: Parameterize the lisp type and implementation globally. Date: Mon, 3 Apr 2017 09:01:27 -0400
* 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. --- gnu/packages/lisp.scm | 23 ++++--- guix/build-system/asdf.scm | 33 +++++----- guix/build/asdf-build-system.scm | 74 ++++++++++----------- guix/build/lisp-utils.scm | 135 +++++++++++++++++++-------------------- 4 files changed, 128 insertions(+), 137 deletions(-) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index 227d81845..09fe897d9 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -854,11 +854,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) @@ -1101,12 +1099,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 @@ -1143,11 +1143,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)) diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm index 1ef6f32d4..4afc6ef1a 100644 --- a/guix/build-system/asdf.scm +++ b/guix/build-system/asdf.scm @@ -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 diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm index c5f2c080d..4305a86af 100644 --- a/guix/build/asdf-build-system.scm +++ b/guix/build/asdf-build-system.scm @@ -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 diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm index 4f1565b55..148357bf0 100644 --- a/guix/build/lisp-utils.scm +++ b/guix/build/lisp-utils.scm @@ -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 <at> 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")))) -- 2.11.1
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Mon, 03 Apr 2017 13:03:07 GMT) Full text and rfc822 format available.Message #41 received at 26346 <at> debbugs.gnu.org (full text, mbox):
From: Andy Patterson <ajpatter <at> uwaterloo.ca> To: 26346 <at> debbugs.gnu.org Cc: Andy Patterson <ajpatter <at> uwaterloo.ca> Subject: [PATCH 12/17] build-system/asdf: Always pre-load the system's definition file. Date: Mon, 3 Apr 2017 09:01:29 -0400
* guix/build-system/asdf.scm (asdf-build)[builder]: Pass a default `#:asd-file' argument to the build procedure, using the system's name. * guix/build/asdf-build-system.scm (build, check): Adjust to assume that `asd-file' will always be a string. * guix/build/lisp-utils.scm (compile-system, system-dependencies) (test-system): Likewise. --- guix/build-system/asdf.scm | 2 +- guix/build/asdf-build-system.scm | 11 ++--------- guix/build/lisp-utils.scm | 27 +++++++++------------------ 3 files changed, 12 insertions(+), 28 deletions(-) diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm index ab571c9b4..6709238e1 100644 --- a/guix/build-system/asdf.scm +++ b/guix/build-system/asdf.scm @@ -294,7 +294,7 @@ set up using CL source package conventions." (derivation->output-path source)) ((source) source) (source source)) - #:asd-file ,asd-file + #:asd-file ,(or asd-file (string-append system-name ".asd")) #:asd-system-name ,system-name #:system ,system #:tests? ,tests? diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm index 0fe01bd6b..cea7b87e8 100644 --- a/guix/build/asdf-build-system.scm +++ b/guix/build/asdf-build-system.scm @@ -115,17 +115,11 @@ valid." (translations (wrap-output-translations `(,(output-translation source-path out)))) - (asd-file (and=> asd-file - (cut source-asd-file out asd-system-name <>)))) + (asd-file (source-asd-file out asd-system-name asd-file))) (setenv "ASDF_OUTPUT_TRANSLATIONS" (replace-escaped-macros (format #f "~S" translations))) - ;; We don't need this if we have the asd file, and it can mess with the - ;; load ordering we're trying to enforce - (unless asd-file - (prepend-to-source-registry (string-append source-path "//"))) - (setenv "HOME" out) ; ecl's asdf sometimes wants to create $HOME/.cache (compile-system asd-system-name asd-file) @@ -141,8 +135,7 @@ valid." #:allow-other-keys) "Test the system." (let* ((out (library-output outputs)) - (asd-file (and=> asd-file - (cut source-asd-file out asd-system-name <>)))) + (asd-file (source-asd-file out asd-system-name asd-file))) (if tests? (test-system asd-system-name asd-file) (format #t "test suite not run~%"))) diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm index 2d730570a..3f7a6f77c 100644 --- a/guix/build/lisp-utils.scm +++ b/guix/build/lisp-utils.scm @@ -112,15 +112,12 @@ with PROGRAM." (define (compile-system system asd-file) "Use a lisp implementation to compile SYSTEM using asdf. Load ASD-FILE -first if SYSTEM is defined there." +first." (lisp-eval-program `(progn (require :asdf) - (in-package :asdf) - ,@(if asd-file - `((load ,asd-file)) - '()) - (in-package :cl-user) + (let ((*package* (find-package :asdf))) + (load ,asd-file)) (funcall (find-symbol (symbol-name :operate) (symbol-name :asdf)) @@ -131,15 +128,13 @@ first if SYSTEM is defined there." (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." +asdf:system-depends-on. First load the system's ASD-FILE." (define deps-file ".deps.sexp") (define program `(progn (require :asdf) - ,@(if asd-file - `((let ((*package* (find-package :asdf))) - (load ,asd-file))) - '()) + (let ((*package* (find-package :asdf))) + (load ,asd-file)) (with-open-file (stream ,deps-file :direction :output) (format stream @@ -183,16 +178,12 @@ asdf:system-depends-on. First load the system's ASD-FILE, if necessary." '()))) (define (test-system system asd-file) - "Use a lisp implementation to test SYSTEM using asdf. Load ASD-FILE first -if SYSTEM is defined there." + "Use a lisp implementation to test SYSTEM using asdf. Load ASD-FILE first." (lisp-eval-program `(progn (require :asdf) - (in-package :asdf) - ,@(if asd-file - `((load ,asd-file)) - '()) - (in-package :cl-user) + (let ((*package* (find-package :asdf))) + (load ,asd-file)) (funcall (find-symbol (symbol-name :test-system) (symbol-name :asdf)) -- 2.11.1
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Mon, 03 Apr 2017 13:03:07 GMT) Full text and rfc822 format available.Message #44 received at 26346 <at> debbugs.gnu.org (full text, mbox):
From: Andy Patterson <ajpatter <at> uwaterloo.ca> To: 26346 <at> debbugs.gnu.org Cc: Andy Patterson <ajpatter <at> uwaterloo.ca> Subject: [PATCH 13/17] build-system/asdf: Handle unusually-named systems. Date: Mon, 3 Apr 2017 09:01:30 -0400
* guix/build/lisp-utils.scm (valid-char-set, normalize-string): New variables. (compiled-system): Truncate the name of a system which contains slashes. (generate-system-definition, make-asd-file): Use `normalize-string' to alter the names of the created system and its dependencies. * guix/build/asdf-build-system.scm (create-asd-file): Normalize the name of the asd file being created. --- guix/build/asdf-build-system.scm | 6 ++++-- guix/build/lisp-utils.scm | 36 ++++++++++++++++++++++++------------ 2 files changed, 28 insertions(+), 14 deletions(-) diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm index cea7b87e8..38365cdec 100644 --- a/guix/build/asdf-build-system.scm +++ b/guix/build/asdf-build-system.scm @@ -150,8 +150,10 @@ valid." (let*-values (((out) (library-output outputs)) ((_ version) (package-name->name+version (strip-store-file-name out))) - ((new-asd-file) (string-append (library-directory out) - "/" asd-system-name ".asd"))) + ((new-asd-file) (string-append + (library-directory out) + "/" (normalize-string asd-system-name) + ".asd"))) (make-asd-file new-asd-file #:system asd-system-name diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm index 3f7a6f77c..c48f51c98 100644 --- a/guix/build/lisp-utils.scm +++ b/guix/build/lisp-utils.scm @@ -40,7 +40,9 @@ prepend-to-source-registry build-program build-image - make-asd-file)) + make-asd-file + valid-char-set + normalize-string)) ;;; Commentary: ;;; @@ -65,6 +67,15 @@ (define (%bundle-install-prefix) (string-append %source-install-prefix "/" (%lisp-type) "-bundle-systems")) +;; See nix/libstore/store-api.cc#checkStoreName. +(define valid-char-set + (string->char-set + "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+-._?=")) + +(define (normalize-string str) + "Replace invalid characters in STR with a hyphen." + (string-join (string-tokenize str valid-char-set) "-")) + (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." @@ -161,14 +172,15 @@ asdf:system-depends-on. First load the system's ASD-FILE." (delete-file deps-file))))) (define (compiled-system system) - (match (%lisp-type) - ("sbcl" (string-append system "--system")) - (_ system))) + (let ((system (basename system))) ; this is how asdf handles slashes + (match (%lisp-type) + ("sbcl" (string-append system "--system")) + (_ system)))) (define* (generate-system-definition system #:key version dependencies) `(asdf:defsystem - ,system + ,(normalize-string system) :class asdf/bundle:prebuilt-system :version ,version :depends-on ,dependencies @@ -261,20 +273,20 @@ to locate its dependent systems." "Create an ASD-FILE for SYSTEM <at> VERSION, appending a program to allow the system to find its dependencies, as described by GENERATE-DEPENDENCY-LINKS." (define dependencies - (system-dependencies system system-asd-file)) + (let ((deps + (system-dependencies system system-asd-file))) + (if (eq? 'NIL deps) + '() + (map normalize-string deps)))) (define lisp-input-map (inputs->asd-file-map inputs)) (define registry (filter-map hash-get-handle - (make-list (if (eq? 'NIL dependencies) - 0 - (length dependencies)) + (make-list (length dependencies) lisp-input-map) - (if (eq? 'NIL dependencies) - '() - dependencies))) + dependencies)) (call-with-output-file asd-file (lambda (port) -- 2.11.1
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Mon, 03 Apr 2017 13:03:08 GMT) Full text and rfc822 format available.Message #47 received at 26346 <at> debbugs.gnu.org (full text, mbox):
From: Andy Patterson <ajpatter <at> uwaterloo.ca> To: 26346 <at> debbugs.gnu.org Cc: Ricardo Wurmus <rekado <at> elephly.net> Subject: [PATCH 14/17] gnu: Add cl-unicode. Date: Mon, 3 Apr 2017 09:01:31 -0400
From: Ricardo Wurmus <rekado <at> elephly.net> * gnu/packages/lisp.scm (sbcl-cl-unicode-base, sbcl-cl-unicode) (ecl-cl-unicode, cl-unicode): New variables. Co-Authored-By: Andy Patterson <ajpatter <at> uwarerloo.ca> --- gnu/packages/lisp.scm | 47 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index 09fe897d9..c8be919c5 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -791,6 +791,53 @@ compatible with ANSI-compliant Common Lisp implementations.") (define-public ecl-cl-ppcre (sbcl-package->ecl-package sbcl-cl-ppcre)) +(define sbcl-cl-unicode-base + (let ((revision "1") + (commit "9fcd06fba1ddc9e66aed2f2d6c32dc9b764f03ea")) + (package + (name "sbcl-cl-unicode-base") + (version (string-append "0.1.5-" revision "." (string-take commit 7))) + (source + (origin + (method git-fetch) + (uri + (git-reference + (url "https://github.com/edicl/cl-unicode.git") + (commit commit))) + (file-name (string-append "cl-unicode-" version "-checkout")) + (sha256 + (base32 + "1jicprb5b3bv57dy1kg03572gxkcaqdjhak00426s76g0plmx5ki")))) + (build-system asdf-build-system/sbcl) + (arguments + '(#:asd-file "cl-unicode.asd" + #:asd-system-name "cl-unicode/base")) + (inputs + `(("cl-ppcre" ,sbcl-cl-ppcre))) + (home-page "http://weitz.de/cl-unicode/") + (synopsis "Portable Unicode library for Common Lisp") + (description "CL-UNICODE is a portable Unicode library Common Lisp, which +is compatible with perl. It is pretty fast, thread-safe, and compatible with +ANSI-compliant Common Lisp implementations.") + (license license:bsd-2)))) + +(define-public sbcl-cl-unicode + (package + (inherit sbcl-cl-unicode-base) + (name "sbcl-cl-unicode") + (inputs + `(("cl-unicode/base" ,sbcl-cl-unicode-base) + ,@(package-inputs sbcl-cl-unicode-base))) + (native-inputs + `(("flexi-streams" ,sbcl-flexi-streams))) + (arguments '()))) + +(define-public ecl-cl-unicode + (sbcl-package->ecl-package sbcl-cl-unicode)) + +(define-public cl-unicode + (sbcl-package->cl-source-package sbcl-cl-unicode)) + (define-public sbcl-clx (let ((revision "1") (commit "1c62774b03c1cf3fe6e5cb532df8b14b44c96b95")) -- 2.11.1
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Mon, 03 Apr 2017 13:03:08 GMT) Full text and rfc822 format available.Message #50 received at 26346 <at> debbugs.gnu.org (full text, mbox):
From: Andy Patterson <ajpatter <at> uwaterloo.ca> To: 26346 <at> debbugs.gnu.org Cc: Andy Patterson <ajpatter <at> uwaterloo.ca> Subject: [PATCH 15/17] build-system/asdf: Simplify the use of lisp-eval-program. Date: Mon, 3 Apr 2017 09:01:32 -0400
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 variable. (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. --- guix/build/lisp-utils.scm | 83 ++++++++++++++++++----------------------------- 1 file changed, 31 insertions(+), 52 deletions(-) diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm index c48f51c98..7d5d41d23 100644 --- a/guix/build/lisp-utils.scm +++ b/guix/build/lisp-utils.scm @@ -101,66 +101,56 @@ name of an ASD system, and asd-file is the full path to its definition." (define (lisp-eval-program program) "Evaluate PROGRAM with a given LISP implementation." (unless (zero? (apply system* - (lisp-invoke (format #f "~S" program)))) + (lisp-invocation 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 with PROGRAM." (match (%lisp-type) - ("sbcl" `(,(%lisp) "--non-interactive" "--eval" ,program)) - ("ecl" `(,(%lisp) "-eval" ,program "-eval" "(quit)")) + ("sbcl" `(,(%lisp) "--non-interactive" + ,@(spread-statements program "--eval"))) + ("ecl" `(,(%lisp) + ,@(spread-statements program "--eval") + "--eval" "(quit)")) (_ (error "The LISP provided is not supported at this time.")))) (define (asdf-load-all systems) (map (lambda (system) - `(funcall - (find-symbol - (symbol-name :load-system) - (symbol-name :asdf)) - ,system)) + `(asdf:load-system ,system)) systems)) (define (compile-system system asd-file) "Use a lisp implementation to compile SYSTEM using asdf. Load ASD-FILE first." (lisp-eval-program - `(progn - (require :asdf) + `((require :asdf) (let ((*package* (find-package :asdf))) (load ,asd-file)) - (funcall (find-symbol - (symbol-name :operate) - (symbol-name :asdf)) - (find-symbol - (symbol-name :compile-bundle-op) - (symbol-name :asdf)) - ,system)))) + (asdf:operate 'asdf:compile-bundle-op ,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." (define deps-file ".deps.sexp") (define program - `(progn - (require :asdf) + `((require :asdf) (let ((*package* (find-package :asdf))) (load ,asd-file)) (with-open-file (stream ,deps-file :direction :output) (format stream "~s~%" - (funcall - (find-symbol - (symbol-name :system-depends-on) - (symbol-name :asdf)) - - (funcall - (find-symbol - (symbol-name :find-system) - (symbol-name :asdf)) - - ,system)))))) + (asdf:system-depends-on + (asdf:find-system ,system)))))) (dynamic-wind (lambda _ @@ -192,33 +182,22 @@ asdf:system-depends-on. First load the system's ASD-FILE." (define (test-system system asd-file) "Use a lisp implementation to test SYSTEM using asdf. Load ASD-FILE first." (lisp-eval-program - `(progn - (require :asdf) + `((require :asdf) (let ((*package* (find-package :asdf))) (load ,asd-file)) - (funcall (find-symbol - (symbol-name :test-system) - (symbol-name :asdf)) - ,system)))) + (asdf:test-system ,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) - "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." + "Use LISP to generate an executable, whose TYPE can be 'asdf:image-op or +'asdf:program-op. The latter will always be standalone. Depends on having +created a \"SYSTEM-exec\" system which contains the entry program." (lisp-eval-program - `(progn - (require :asdf) - (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"))))) + `((require :asdf) + (asdf:operate ',type ,(string-append system "-exec"))))) (define (generate-executable-wrapper-system system dependencies) "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 #:dependencies dependencies #:entry-program entry-program - #:type "program") + #:type 'asdf:program-op) (let* ((name (basename program)) (bin-directory (dirname program))) (with-directory-excursion bin-directory @@ -346,7 +325,7 @@ placing the result in IMAGE.image." (generate-executable image #:dependencies dependencies #:entry-program '(nil) - #:type "image") + #:type 'asdf:image-op) (let* ((name (basename image)) (bin-directory (dirname image))) (with-directory-excursion bin-directory @@ -359,7 +338,7 @@ placing the result in IMAGE.image." entry-program type #: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 executable." (let* ((bin-directory (dirname out-file)) -- 2.11.1
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Mon, 03 Apr 2017 13:03:09 GMT) Full text and rfc822 format available.Message #53 received at 26346 <at> debbugs.gnu.org (full text, mbox):
From: Andy Patterson <ajpatter <at> uwaterloo.ca> To: 26346 <at> debbugs.gnu.org Cc: Andy Patterson <ajpatter <at> uwaterloo.ca> Subject: [PATCH 16/17] build-system/asdf: Retain references to source files for binary outputs. Date: Mon, 3 Apr 2017 09:01:33 -0400
In support of long-running programs in which the users would like to be able to jump to the source of a definition of any of the dependencies (itself included) of the program. * guix/build/asdf-build-system.scm (library-outputs): Move from here ... * guix/build/lisp-utils.scm (library-outputs): ... to here. (build-program): Accept dependency-prefixes argument, to allow the caller to specify references which should be retained. Default to the library's output. (build-image): Likewise. (generate-executable): Likewise. * gnu/packages/lisp.scm (sbcl-stumpwm+slynk, sbcl-slynk, sbcl-stumpwm): Adjust accordingly to the new interface. (sbcl-stumpwm+slynk)[native-inputs]: Move to ... [inputs]: ... here. --- gnu/packages/lisp.scm | 13 ++++++++---- guix/build/asdf-build-system.scm | 4 ---- guix/build/lisp-utils.scm | 44 ++++++++++++++++++++++++++++++++++------ 3 files changed, 47 insertions(+), 14 deletions(-) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index c8be919c5..24a0ff84d 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -904,6 +904,7 @@ from other CLXes around the net.") (lambda* (#:key outputs #:allow-other-keys) (build-program (string-append (assoc-ref outputs "out") "/bin/stumpwm") + outputs #:entry-program '((stumpwm:stumpwm) 0)))) (add-after 'build-program 'create-desktop-file (lambda* (#:key outputs #:allow-other-keys) @@ -1153,6 +1154,7 @@ multiple inspectors with independent history.") (build-image (string-append (assoc-ref %outputs "image") "/bin/slynk") + %outputs #:dependencies ',slynk-systems))))))) (define-public ecl-slynk @@ -1182,7 +1184,7 @@ multiple inspectors with independent history.") (inherit sbcl-stumpwm) (name "sbcl-stumpwm-with-slynk") (outputs '("out")) - (native-inputs + (inputs `(("stumpwm" ,sbcl-stumpwm "lib") ("slynk" ,sbcl-slynk))) (arguments @@ -1190,13 +1192,16 @@ multiple inspectors with independent history.") ((#:phases phases) `(modify-phases ,phases (replace 'build-program - (lambda* (#:key outputs #:allow-other-keys) + (lambda* (#:key inputs outputs #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) (program (string-append out "/bin/stumpwm"))) - (build-program program + (build-program program outputs #:entry-program '((stumpwm:stumpwm) 0) #:dependencies '("stumpwm" - ,@slynk-systems)) + ,@slynk-systems) + #:dependency-prefixes + (map (lambda (input) (assoc-ref inputs input)) + '("stumpwm" "slynk"))) ;; Remove unneeded file. (delete-file (string-append out "/bin/stumpwm-exec.fasl")) #t))) diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm index 38365cdec..4d626f84d 100644 --- a/guix/build/asdf-build-system.scm +++ b/guix/build/asdf-build-system.scm @@ -71,10 +71,6 @@ to it's binary output." (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'." - (or (assoc-ref outputs "lib") (assoc-ref outputs "out"))) - (define (copy-files-to-output out name) "Copy all files from the current directory to OUT. Create an extra link to any system-defining files in the source to a convenient location. This is diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm index 7d5d41d23..cadbf4e6b 100644 --- a/guix/build/lisp-utils.scm +++ b/guix/build/lisp-utils.scm @@ -42,7 +42,8 @@ build-image make-asd-file valid-char-set - normalize-string)) + normalize-string + library-output)) ;;; Commentary: ;;; @@ -67,6 +68,10 @@ (define (%bundle-install-prefix) (string-append %source-install-prefix "/" (%lisp-type) "-bundle-systems")) +(define (library-output outputs) + "If a `lib' output exists, build things there. Otherwise use `out'." + (or (assoc-ref outputs "lib") (assoc-ref outputs "out"))) + ;; See nix/libstore/store-api.cc#checkStoreName. (define valid-char-set (string->char-set @@ -298,16 +303,20 @@ which are not nested." (setenv "CL_SOURCE_REGISTRY" (string-append path ":" (or (getenv "CL_SOURCE_REGISTRY") "")))) -(define* (build-program program #:key +(define* (build-program program outputs #:key + (dependency-prefixes (list (library-output outputs))) (dependencies (list (basename program))) entry-program #:allow-other-keys) "Generate an executable program containing all DEPENDENCIES, and which will 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." +has been bound to the command-line arguments which were passed. Link in any +asd files from DEPENDENCY-PREFIXES to ensure references to those libraries are +retained." (generate-executable program #:dependencies dependencies + #:dependency-prefixes dependency-prefixes #:entry-program entry-program #:type 'asdf:program-op) (let* ((name (basename program)) @@ -317,13 +326,16 @@ has been bound to the command-line arguments which were passed." name))) #t) -(define* (build-image image #:key +(define* (build-image image outputs #:key + (dependency-prefixes (list (library-output outputs))) (dependencies (list (basename image))) #:allow-other-keys) "Generate an image, possibly standalone, which contains all DEPENDENCIES, -placing the result in IMAGE.image." +placing the result in IMAGE.image. Link in any asd files from +DEPENDENCY-PREFIXES to ensure references to those libraries are retained." (generate-executable image #:dependencies dependencies + #:dependency-prefixes dependency-prefixes #:entry-program '(nil) #:type 'asdf:image-op) (let* ((name (basename image)) @@ -335,12 +347,14 @@ placing the result in IMAGE.image." (define* (generate-executable out-file #:key dependencies + dependency-prefixes entry-program type #:allow-other-keys) "Generate an executable by using asdf operation TYPE, containing whithin the image all DEPENDENCIES, and running ENTRY-PROGRAM in the case of an -executable." +executable. Link in any asd files from DEPENDENCY-PREFIXES to ensure +references to those libraries are retained." (let* ((bin-directory (dirname out-file)) (name (basename out-file))) (mkdir-p bin-directory) @@ -361,5 +375,23 @@ executable." (generate-executable-for-system type name) + (let* ((third-slash-index + (string-index out-file #\/ + (1+ (string-length (%store-directory))))) + (output (string-take out-file third-slash-index)) + (hidden-asd-links (string-append output "/.asd-files"))) + + (mkdir-p hidden-asd-links) + (for-each + (lambda (path) + (for-each + (lambda (asd-file) + (symlink asd-file + (string-append hidden-asd-links + "/" (basename asd-file)))) + (find-files (string-append path (%bundle-install-prefix)) + "\\.asd$"))) + dependency-prefixes)) + (delete-file (string-append bin-directory "/" name "-exec.asd")) (delete-file (string-append bin-directory "/" name "-exec.lisp")))) -- 2.11.1
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Mon, 03 Apr 2017 13:03:09 GMT) Full text and rfc822 format available.Message #56 received at 26346 <at> debbugs.gnu.org (full text, mbox):
From: Andy Patterson <ajpatter <at> uwaterloo.ca> To: 26346 <at> debbugs.gnu.org Cc: Andy Patterson <ajpatter <at> uwaterloo.ca> Subject: [PATCH 17/17] gnu: sbcl-slynk-boot0: Give the package an appropriate name. Date: Mon, 3 Apr 2017 09:01:34 -0400
* gnu/packages/lisp.scm (sbcl-slynk-boot0)[name]: Change it to reflect the bootstrap status of the package. [arguments]<#:asd-system-name>: Add the appropriate value. (sbcl-slynk-arglists)[arguments]: Set the appropriate #:asd-file and forcibly unset #:asd-system-name. (sbcl-slynk)[name]: Change it to the variable name. --- gnu/packages/lisp.scm | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index 24a0ff84d..e6027cac5 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -951,7 +951,7 @@ productive, customizable lisp based systems.") (let ((revision "1") (commit "5706cd45d484a4f25795abe8e643509d31968aa2")) (package - (name "sbcl-slynk") ; name must refer to the system name for now + (name "sbcl-slynk-boot0") (version (string-append "1.0.0-beta-" revision "." (string-take commit 7))) (source (origin @@ -991,7 +991,8 @@ productive, customizable lisp based systems.") (scandir "slynk")))))) (build-system asdf-build-system/sbcl) (arguments - `(#:tests? #f)) ; No test suite + `(#:tests? #f ; No test suite + #:asd-system-name "slynk")) (synopsis "Common Lisp IDE for Emacs") (description "SLY is a fork of SLIME, an IDE backend for Common Lisp. It also features a completely redesigned REPL based on Emacs's own @@ -1014,8 +1015,9 @@ multiple inspectors with independent history.") (name "sbcl-slynk-arglists") (inputs `(("slynk" ,sbcl-slynk-boot0))) (arguments - `(#:asd-file "slynk.asd" - ,@(package-arguments sbcl-slynk-boot0))))) + (substitute-keyword-arguments (package-arguments sbcl-slynk-boot0) + ((#:asd-file _ "") "slynk.asd") + ((#:asd-system-name _ #f) #f))))) (define ecl-slynk-arglists (sbcl-package->ecl-package sbcl-slynk-arglists)) @@ -1110,6 +1112,7 @@ multiple inspectors with independent history.") (define-public sbcl-slynk (package (inherit sbcl-slynk-boot0) + (name "sbcl-slynk") (inputs `(("slynk" ,sbcl-slynk-boot0) ("slynk-util" ,sbcl-slynk-util) -- 2.11.1
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Sun, 09 Apr 2017 03:44:02 GMT) Full text and rfc822 format available.Message #59 received at 26346 <at> debbugs.gnu.org (full text, mbox):
From: Andy Patterson <ajpatter <at> uwaterloo.ca> To: 26346 <at> debbugs.gnu.org Cc: Andy Patterson <ajpatter <at> uwaterloo.ca> Subject: [PATCH 19/20] build-system/asdf: Handle versioned asdf dependencies. Date: Sat, 8 Apr 2017 23:43:32 -0400
Add support for depencies of the form (:version <name> <version>). * guix/build/lisp-utils.scm (normalize-dependency): New variable. (make-asd-file)[dependencies]: Use it to generate dependencies with normalized names. [dependency-name]: New variable. [registry]: Use it to flatten the normalized dependencies. --- guix/build/lisp-utils.scm | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm index 6d9341bb2..3744bac9d 100644 --- a/guix/build/lisp-utils.scm +++ b/guix/build/lisp-utils.scm @@ -81,6 +81,13 @@ "Replace invalid characters in STR with a hyphen." (string-join (string-tokenize str valid-char-set) "-")) +(define (normalize-dependency dependency) + "Normalize the name of DEPENDENCY." + (match dependency + ((:version name rest ...) + `(:version ,(normalize-string name) ,@rest)) + (name (normalize-string name)))) + (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." @@ -273,16 +280,21 @@ system to find its dependencies, as described by GENERATE-DEPENDENCY-LINKS." (system-dependencies system system-asd-file))) (if (eq? 'NIL deps) '() - (map normalize-string deps)))) + (map normalize-dependency deps)))) (define lisp-input-map (inputs->asd-file-map inputs)) + (define dependency-name + (match-lambda + ((_ name _ ...) name) + (name name))) + (define registry (filter-map hash-get-handle (make-list (length dependencies) lisp-input-map) - dependencies)) + (map dependency-name dependencies))) (call-with-output-file asd-file (lambda (port) -- 2.12.2
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Sun, 09 Apr 2017 03:44:02 GMT) Full text and rfc822 format available.Message #62 received at 26346 <at> debbugs.gnu.org (full text, mbox):
From: Andy Patterson <ajpatter <at> uwaterloo.ca> To: 26346 <at> debbugs.gnu.org Cc: Andy Patterson <ajpatter <at> uwaterloo.ca> Subject: [PATCH 18/20] build-system/asdf: Handle tests defined in external systems. Date: Sat, 8 Apr 2017 23:43:31 -0400
* guix/build-system/asdf.scm (asdf-build): Add a #:test-asd-file argument. [builder]: Pass it to the build system. (package-with-build-system)[transform]: Strip it from source systems' arguments. * guix/build/asdf-build-system.scm (check): Pass the fully qualified path to it on to the test-system procedure. * guix/build/lisp-utils.scm (test-system): Load the file, or otherwise one of the often used names for it, before running the tests. Adjust the docstring accordingly. --- guix/build-system/asdf.scm | 4 +++- guix/build/asdf-build-system.scm | 8 ++++++-- guix/build/lisp-utils.scm | 18 +++++++++++++++--- 3 files changed, 24 insertions(+), 6 deletions(-) diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm index 6709238e1..d992624a9 100644 --- a/guix/build-system/asdf.scm +++ b/guix/build-system/asdf.scm @@ -199,7 +199,7 @@ set up using CL source package conventions." (define base-arguments (if target-is-source? (strip-keyword-arguments - '(#:tests? #:asd-file #:lisp #:asd-system-name) + '(#:tests? #:asd-file #:lisp #:asd-system-name #:test-asd-file) (package-arguments pkg)) (package-arguments pkg))) @@ -266,6 +266,7 @@ set up using CL source package conventions." (tests? #t) (asd-file #f) (asd-system-name #f) + (test-asd-file #f) (phases '(@ (guix build asdf-build-system) %standard-phases)) (search-paths '()) @@ -296,6 +297,7 @@ set up using CL source package conventions." (source source)) #:asd-file ,(or asd-file (string-append system-name ".asd")) #:asd-system-name ,system-name + #:test-asd-file ,test-asd-file #:system ,system #:tests? ,tests? #:phases ,phases diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm index 1e0a2f6de..c5e820a00 100644 --- a/guix/build/asdf-build-system.scm +++ b/guix/build/asdf-build-system.scm @@ -131,12 +131,16 @@ valid." #t) (define* (check #:key tests? outputs inputs asd-file asd-system-name + test-asd-file #:allow-other-keys) "Test the system." (let* ((out (library-output outputs)) - (asd-file (source-asd-file out asd-system-name asd-file))) + (asd-file (source-asd-file out asd-system-name asd-file)) + (test-asd-file + (and=> test-asd-file + (cut source-asd-file out asd-system-name <>)))) (if tests? - (test-system asd-system-name asd-file) + (test-system asd-system-name asd-file test-asd-file) (format #t "test suite not run~%"))) #t) diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm index cadbf4e6b..6d9341bb2 100644 --- a/guix/build/lisp-utils.scm +++ b/guix/build/lisp-utils.scm @@ -184,12 +184,24 @@ asdf:system-depends-on. First load the system's ASD-FILE." `(:lib ,(string-append system ".a")) '()))) -(define (test-system system asd-file) - "Use a lisp implementation to test SYSTEM using asdf. Load ASD-FILE first." +(define (test-system system asd-file test-asd-file) + "Use a lisp implementation to test SYSTEM using asdf. Load ASD-FILE first. +Also load TEST-ASD-FILE if necessary." (lisp-eval-program `((require :asdf) (let ((*package* (find-package :asdf))) - (load ,asd-file)) + (load ,asd-file) + ,@(if test-asd-file + `((load ,test-asd-file)) + ;; Try some likely files. + (map (lambda (file) + `(when (uiop:file-exists-p ,file) + (load ,file))) + (list + (string-append system "-tests.asd") + (string-append system "-test.asd") + "tests.asd" + "test.asd")))) (asdf:test-system ,system)))) (define (string->lisp-keyword . strings) -- 2.12.2
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Sun, 09 Apr 2017 03:44:03 GMT) Full text and rfc822 format available.Message #65 received at 26346 <at> debbugs.gnu.org (full text, mbox):
From: Andy Patterson <ajpatter <at> uwaterloo.ca> To: 26346 <at> debbugs.gnu.org Cc: Andy Patterson <ajpatter <at> uwaterloo.ca> Subject: [PATCH 20/20] doc: Update the documentation for the asdf build systems. Date: Sat, 8 Apr 2017 23:43:33 -0400
* doc/guix.texi (Build Systems)<asdf-build-system/source> <asdf-build-system/sbcl, asdf-build-system/ecl>: Remove the no-longer relevant parts about naming inputs. Add documentation for the new parameters #:asd-system-name and #:test-asd-file. --- doc/guix.texi | 30 ++++++++++++------------------ 1 file changed, 12 insertions(+), 18 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 974d9b3a4..f3a4531a6 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3346,23 +3346,8 @@ These build systems can also be used to produce executable programs, or lisp images which contain a set of packages pre-loaded. The build system uses naming conventions. For binary packages, the -package itself as well as its run-time dependencies should begin their -name with the lisp implementation, such as @code{sbcl-} for -@code{asdf-build-system/sbcl}. Beginning the input name with this -prefix will allow the build system to encode its location into the -resulting library, so that the input can be found at run-time. - -If dependencies are used only for tests, it is convenient to use a -different prefix in order to avoid having a run-time dependency on such -systems. For example, - -@example -(define-public sbcl-bordeaux-threads - (package - ... - (native-inputs `(("tests:cl-fiveam" ,sbcl-fiveam))) - ...)) -@end example +package name should be prefixed with the lisp implementation, such as +@code{sbcl-} for @code{asdf-build-system/sbcl}. Additionally, the corresponding source package should be labeled using the same convention as python packages (see @ref{Python Modules}), using @@ -3382,7 +3367,16 @@ expressions to be passed as the @code{#:entry-program} argument. If the system is not defined within its own @code{.asd} file of the same name, then the @code{#:asd-file} parameter should be used to specify -which file the system is defined in. +which file the system is defined in. Furthermore, if the package +defines a system for its tests in a separate file, it will be loaded +before the tests are run if it is specified by the +@code{#:test-asd-file} parameter. If it is not set, the files +@code{<system>-tests.asd}, @code{<system>-test.asd}, @code{tests.asd}, +and @code{test.asd} will be tried if they exist. + +If for some reason the package must be named in a different way than the +naming conventions suggest, the @code{#:asd-system-name} parameter can +be used to specify the name of the system. @end defvr -- 2.12.2
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Sun, 09 Apr 2017 03:49:01 GMT) Full text and rfc822 format available.Message #68 received at 26346 <at> debbugs.gnu.org (full text, mbox):
From: Andy Patterson <ajpatter <at> uwaterloo.ca> To: 26346 <at> debbugs.gnu.org Cc: Andy Patterson <ajpatter <at> uwaterloo.ca> Subject: [PATCH v2 11/20] build-system/asdf: Pass the system name as an argument to the builder. Date: Sat, 8 Apr 2017 23:48:38 -0400
From 81f4bee23f9b11e549284877319ff43e8595f2dc Mon Sep 17 00:00:00 2001 From: Andy Patterson <ajpatter <at> uwaterloo.ca> Date: Sun, 2 Apr 2017 13:28:56 -0400 Subject: [PATCH v2 11/20] build-system/asdf: Pass the system name as an argument to the builder. * guix/build-system/asdf.scm (asdf-build): Use the user-defined system name, or calculate it from the package's full name. [builder]: Pass the value along to the build procedure. (package-with-build-system): Remove #:asd-system-name from source packages' arguments. * guix/build/asdf-build-system.scm: Adjust accordingly. * guix/build/lisp-utils.scm (remove-lisp-from-name): Delete variable. --- guix/build-system/asdf.scm | 14 ++++++++++++- guix/build/asdf-build-system.scm | 45 +++++++++++++++++----------------------- guix/build/lisp-utils.scm | 4 ---- 3 files changed, 32 insertions(+), 31 deletions(-) diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm index 4afc6ef1a..ab571c9b4 100644 --- a/guix/build-system/asdf.scm +++ b/guix/build-system/asdf.scm @@ -22,6 +22,9 @@ #:use-module (guix packages) #:use-module (guix derivations) #:use-module (guix search-paths) + #:use-module ((guix build utils) + #:select ((package-name->name+version + . hyphen-separated-name->name+version))) #:use-module (guix build-system) #:use-module (guix build-system gnu) #:use-module (ice-9 match) @@ -196,7 +199,7 @@ set up using CL source package conventions." (define base-arguments (if target-is-source? (strip-keyword-arguments - '(#:tests? #:asd-file #:lisp) + '(#:tests? #:asd-file #:lisp #:asd-system-name) (package-arguments pkg)) (package-arguments pkg))) @@ -262,6 +265,7 @@ set up using CL source package conventions." #:key source outputs (tests? #t) (asd-file #f) + (asd-system-name #f) (phases '(@ (guix build asdf-build-system) %standard-phases)) (search-paths '()) @@ -270,6 +274,13 @@ set up using CL source package conventions." (imported-modules %asdf-build-system-modules) (modules %asdf-build-modules)) + (define system-name + (or asd-system-name + (string-drop + ;; NAME is the value returned from `package-full-name'. + (hyphen-separated-name->name+version name) + (1+ (string-length lisp-type))))) ; drop the "<lisp>-" prefixa + (define builder `(begin (use-modules ,@modules) @@ -284,6 +295,7 @@ set up using CL source package conventions." ((source) source) (source source)) #:asd-file ,asd-file + #:asd-system-name ,system-name #:system ,system #:tests? ,tests? #:phases ,phases diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm index 4305a86af..20116a488 100644 --- a/guix/build/asdf-build-system.scm +++ b/guix/build/asdf-build-system.scm @@ -49,13 +49,6 @@ (define %system-install-prefix (string-append %source-install-prefix "/systems")) -(define (output-path->package-name path) - (package-name->name+version (strip-store-file-name path))) - -(define (outputs->name outputs) - (output-path->package-name - (assoc-ref outputs "out"))) - (define (lisp-source-directory output name) (string-append output (%lisp-source-install-prefix) "/" name)) @@ -101,31 +94,32 @@ valid." (define* (install #:key outputs #:allow-other-keys) "Copy and symlink all the source files." - (copy-files-to-output (assoc-ref outputs "out") (outputs->name outputs))) + (define output (assoc-ref outputs "out")) + (copy-files-to-output output + (package-name->name+version + (strip-store-file-name output)))) -(define* (copy-source #:key outputs #:allow-other-keys) +(define* (copy-source #:key outputs asd-system-name #: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))) (install-path (string-append out %source-install-prefix))) - (copy-files-to-output out name) + (copy-files-to-output out asd-system-name) ;; Hide the files from asdf (with-directory-excursion install-path (rename-file "source" (string-append (%lisp-type) "-source")) (delete-file-recursively "systems"))) #t) -(define* (build #:key outputs inputs asd-file +(define* (build #:key outputs inputs asd-file asd-system-name #:allow-other-keys) "Compile the system." (let* ((out (library-output outputs)) - (name (remove-lisp-from-name (output-path->package-name out))) - (source-path (lisp-source-directory out name)) + (source-path (lisp-source-directory out asd-system-name)) (translations (wrap-output-translations `(,(output-translation source-path out)))) (asd-file (and=> asd-file - (cut source-asd-file out name <>)))) + (cut source-asd-file out asd-system-name <>)))) (setenv "ASDF_OUTPUT_TRANSLATIONS" (replace-escaped-macros (format #f "~S" translations))) @@ -137,7 +131,7 @@ valid." (setenv "HOME" out) ; ecl's asdf sometimes wants to create $HOME/.cache - (compile-system name asd-file) + (compile-system asd-system-name asd-file) ;; As above, ecl will sometimes create this even though it doesn't use it @@ -146,32 +140,31 @@ valid." (delete-file-recursively cache-directory)))) #t) -(define* (check #:key tests? outputs inputs asd-file +(define* (check #:key tests? outputs inputs asd-file asd-system-name #:allow-other-keys) "Test the system." - (let* ((name (remove-lisp-from-name (outputs->name outputs))) - (out (library-output outputs)) + (let* ((out (library-output outputs)) (asd-file (and=> asd-file - (cut source-asd-file out name <>)))) + (cut source-asd-file out asd-system-name <>)))) (if tests? - (test-system name asd-file) + (test-system asd-system-name asd-file) (format #t "test suite not run~%"))) #t) (define* (create-asd-file #:key outputs inputs asd-file + asd-system-name #: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)) + ((_ version) (package-name->name+version + (strip-store-file-name out))) ((new-asd-file) (string-append (library-directory out) - "/" name ".asd"))) + "/" asd-system-name ".asd"))) (make-asd-file new-asd-file - #:system name + #:system asd-system-name #:version version #:inputs inputs #:system-asd-file asd-file)) diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm index 148357bf0..2d730570a 100644 --- a/guix/build/lisp-utils.scm +++ b/guix/build/lisp-utils.scm @@ -36,7 +36,6 @@ generate-executable-for-system %bundle-install-prefix bundle-asd-file - remove-lisp-from-name wrap-output-translations prepend-to-source-registry build-program @@ -66,9 +65,6 @@ (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) "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." -- 2.12.2
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Sun, 09 Apr 2017 03:51:02 GMT) Full text and rfc822 format available.Message #71 received at 26346 <at> debbugs.gnu.org (full text, mbox):
From: Andy Patterson <ajpatter <at> uwaterloo.ca> To: 26346 <at> debbugs.gnu.org Cc: Andy Patterson <ajpatter <at> uwaterloo.ca> Subject: [PATCH v2 17/20] gnu: sbcl-slynk-boot0: Give the package an appropriate name. Date: Sat, 8 Apr 2017 23:50:01 -0400
From 7fd6d035a8f97b085b3de50ae04ec570538ff283 Mon Sep 17 00:00:00 2001 From: Andy Patterson <ajpatter <at> uwaterloo.ca> Date: Mon, 3 Apr 2017 00:04:52 -0400 Subject: [PATCH v2 17/20] gnu: sbcl-slynk-boot0: Give the package an appropriate name. * gnu/packages/lisp.scm (sbcl-slynk-boot0)[name]: Change it to reflect the bootstrap status of the package. [arguments]<#:asd-system-name>: Add the appropriate value. (sbcl-slynk-arglists)[arguments]: Set the appropriate #:asd-file and forcibly unset #:asd-system-name. (sbcl-slynk)[name]: Change it to the variable name. (cl-slynk)[name]: Likewise. --- gnu/packages/lisp.scm | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index 24a0ff84d..a2016482c 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -951,7 +951,7 @@ productive, customizable lisp based systems.") (let ((revision "1") (commit "5706cd45d484a4f25795abe8e643509d31968aa2")) (package - (name "sbcl-slynk") ; name must refer to the system name for now + (name "sbcl-slynk-boot0") (version (string-append "1.0.0-beta-" revision "." (string-take commit 7))) (source (origin @@ -991,7 +991,8 @@ productive, customizable lisp based systems.") (scandir "slynk")))))) (build-system asdf-build-system/sbcl) (arguments - `(#:tests? #f)) ; No test suite + `(#:tests? #f ; No test suite + #:asd-system-name "slynk")) (synopsis "Common Lisp IDE for Emacs") (description "SLY is a fork of SLIME, an IDE backend for Common Lisp. It also features a completely redesigned REPL based on Emacs's own @@ -1003,7 +1004,9 @@ multiple inspectors with independent history.") (properties `((cl-source-variant . ,(delay cl-slynk))))))) (define-public cl-slynk - (sbcl-package->cl-source-package sbcl-slynk-boot0)) + (package + (inherit (sbcl-package->cl-source-package sbcl-slynk-boot0)) + (name "cl-slynk"))) (define ecl-slynk-boot0 (sbcl-package->ecl-package sbcl-slynk-boot0)) @@ -1014,8 +1017,9 @@ multiple inspectors with independent history.") (name "sbcl-slynk-arglists") (inputs `(("slynk" ,sbcl-slynk-boot0))) (arguments - `(#:asd-file "slynk.asd" - ,@(package-arguments sbcl-slynk-boot0))))) + (substitute-keyword-arguments (package-arguments sbcl-slynk-boot0) + ((#:asd-file _ "") "slynk.asd") + ((#:asd-system-name _ #f) #f))))) (define ecl-slynk-arglists (sbcl-package->ecl-package sbcl-slynk-arglists)) @@ -1110,6 +1114,7 @@ multiple inspectors with independent history.") (define-public sbcl-slynk (package (inherit sbcl-slynk-boot0) + (name "sbcl-slynk") (inputs `(("slynk" ,sbcl-slynk-boot0) ("slynk-util" ,sbcl-slynk-util) -- 2.12.2
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Sun, 09 Apr 2017 03:59:01 GMT) Full text and rfc822 format available.Message #74 received at 26346 <at> debbugs.gnu.org (full text, mbox):
From: Andy Patterson <ajpatter <at> uwaterloo.ca> To: 26346 <at> debbugs.gnu.org Subject: Re: bug#26346: [PATCH] asdf-build-system improvements. Date: Sat, 8 Apr 2017 23:58:05 -0400
I've added some further changes to make sure everything works (whoops). -- Andy
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Tue, 16 May 2017 07:03:02 GMT) Full text and rfc822 format available.Message #77 received at 26346 <at> debbugs.gnu.org (full text, mbox):
From: Ricardo Wurmus <rekado <at> elephly.net> To: Andy Patterson <ajpatter <at> uwaterloo.ca> Cc: 26346 <at> debbugs.gnu.org Subject: Re: bug#26346: [PATCH 16/17] build-system/asdf: Retain references to source files for binary outputs. Date: Tue, 16 May 2017 09:02:24 +0200
Andy Patterson <ajpatter <at> uwaterloo.ca> writes: > In support of long-running programs in which the users would like to be able > to jump to the source of a definition of any of the dependencies (itself > included) of the program. > > * guix/build/asdf-build-system.scm (library-outputs): Move from here ... > * guix/build/lisp-utils.scm (library-outputs): ... to here. > (build-program): Accept dependency-prefixes argument, to allow the caller to > specify references which should be retained. Default to the library's output. > (build-image): Likewise. > (generate-executable): Likewise. > * gnu/packages/lisp.scm (sbcl-stumpwm+slynk, sbcl-slynk, sbcl-stumpwm): Adjust > accordingly to the new interface. > (sbcl-stumpwm+slynk)[native-inputs]: Move to ... > [inputs]: ... here. > --- […] > @@ -361,5 +375,23 @@ executable." > > (generate-executable-for-system type name) > > + (let* ((third-slash-index > + (string-index out-file #\/ > + (1+ (string-length (%store-directory))))) > + (output (string-take out-file third-slash-index)) > + (hidden-asd-links (string-append output "/.asd-files"))) > + > + (mkdir-p hidden-asd-links) > + (for-each > + (lambda (path) > + (for-each > + (lambda (asd-file) > + (symlink asd-file > + (string-append hidden-asd-links > + "/" (basename asd-file)))) > + (find-files (string-append path (%bundle-install-prefix)) > + "\\.asd$"))) > + dependency-prefixes)) > + > (delete-file (string-append bin-directory "/" name "-exec.asd")) > (delete-file (string-append bin-directory "/" name "-exec.lisp")))) The naming here implies that the package is at the third level, but users can have a store an arbitrary number of directories deep. “third-slash-index” is really just the position after the store prefix, so I’m going to rename it before pushing. I don’t really like the use of “dependency-prefixes”. It seems inelegant. Can the build system not determine automatically what references ought to be retained? That said, I’m going to push this first, as it is an improvement. -- Ricardo GPG: BCA6 89B6 3655 3801 C3C6 2150 197A 5888 235F ACAC https://elephly.net
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Tue, 16 May 2017 08:18:02 GMT) Full text and rfc822 format available.Message #80 received at 26346 <at> debbugs.gnu.org (full text, mbox):
From: Ricardo Wurmus <rekado <at> elephly.net> To: Andy Patterson <ajpatter <at> uwaterloo.ca> Cc: 26346 <at> debbugs.gnu.org Subject: Re: bug#26346: [PATCH 19/20] build-system/asdf: Handle versioned asdf dependencies. Date: Tue, 16 May 2017 10:17:14 +0200
Andy Patterson <ajpatter <at> uwaterloo.ca> writes: > Add support for depencies of the form (:version <name> <version>). > > * guix/build/lisp-utils.scm (normalize-dependency): New variable. > (make-asd-file)[dependencies]: Use it to generate dependencies with normalized > names. > [dependency-name]: New variable. > [registry]: Use it to flatten the normalized dependencies. > --- Could you please explain how this is to be used and why it’s needed? Where would this be specified? -- Ricardo GPG: BCA6 89B6 3655 3801 C3C6 2150 197A 5888 235F ACAC https://elephly.net
Ricardo Wurmus <rekado <at> elephly.net>
:Andy Patterson <ajpatter <at> uwaterloo.ca>
:Message #85 received at 26346-done <at> debbugs.gnu.org (full text, mbox):
From: Ricardo Wurmus <rekado <at> elephly.net> To: Andy Patterson <ajpatter <at> uwaterloo.ca> Cc: guix-devel <at> gnu.org, 26346-done <at> debbugs.gnu.org Subject: Re: bug#26346: [PATCH] asdf-build-system improvements. Date: Tue, 16 May 2017 15:19:04 +0200
Hi Andy, > As promised a long time ago, I'm attaching patches to improve the state > of the asdf-build-system. I will push your patches with some very minor changes (e.g. fixed typos, slightly adjusted commit summaries) after confirming that stumpwm still works fine. Thank you for your patches and your patience! > As a result, there will be some changes that > users should be aware of. Users of stumpwm should include sbcl-stumpwm > as opposed to (list sbcl-stumpwm "bin") in their OS configurations, or > sbcl-stumpwm instead of sbcl-stumpwm:bin in their profiles. @guix-devel: please note this change and make adjustments to your manifests or OS configurations if you’re using StumpWM. -- Ricardo GPG: BCA6 89B6 3655 3801 C3C6 2150 197A 5888 235F ACAC https://elephly.net
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Wed, 17 May 2017 13:12:01 GMT) Full text and rfc822 format available.Message #88 received at 26346 <at> debbugs.gnu.org (full text, mbox):
From: ludo <at> gnu.org (Ludovic Courtès) To: 26346 <at> debbugs.gnu.org Cc: rekado <at> elephly.net, ajpatter <at> uwaterloo.ca Subject: Re: bug#26346: [PATCH] asdf-build-system improvements. Date: Wed, 17 May 2017 15:11:33 +0200
Ricardo Wurmus <rekado <at> elephly.net> skribis: >> As a result, there will be some changes that >> users should be aware of. Users of stumpwm should include sbcl-stumpwm >> as opposed to (list sbcl-stumpwm "bin") in their OS configurations, or >> sbcl-stumpwm instead of sbcl-stumpwm:bin in their profiles. > > @guix-devel: please note this change and make adjustments to your > manifests or OS configurations if you’re using StumpWM. The ‘deprecated-package’ mechanism handles package renames but not output renames. Perhaps it could handle output renames as well, for outputs that have been removed. Ludo’.
guix-patches <at> gnu.org
:bug#26346
; Package guix-patches
.
(Mon, 22 May 2017 02:36:01 GMT) Full text and rfc822 format available.Message #91 received at 26346 <at> debbugs.gnu.org (full text, mbox):
From: Andy Patterson <ajpatter <at> uwaterloo.ca> To: Ricardo Wurmus <rekado <at> elephly.net> Cc: 26346 <at> debbugs.gnu.org Subject: Re: bug#26346: [PATCH 19/20] build-system/asdf: Handle versioned asdf dependencies. Date: Sun, 21 May 2017 22:35:03 -0400
On Tue, 16 May 2017 10:17:14 +0200 Ricardo Wurmus <rekado <at> elephly.net> wrote: > Andy Patterson <ajpatter <at> uwaterloo.ca> writes: > > > Add support for depencies of the form (:version <name> <version>). > > > > * guix/build/lisp-utils.scm (normalize-dependency): New variable. > > (make-asd-file)[dependencies]: Use it to generate dependencies with > > normalized names. > > [dependency-name]: New variable. > > [registry]: Use it to flatten the normalized dependencies. > > --- > > Could you please explain how this is to be used and why it’s needed? > Where would this be specified? > Here's an updated patch. I've found the upstream documentation describing how dependencies are defined and implemented the full specification. Let me know if there are still concerns I need to address. Thanks for taking a look at this series! -- Andy From 583c9e410594cd68a768edf0d00a787b9f77cd28 Mon Sep 17 00:00:00 2001 From: Andy Patterson <ajpatter <at> uwaterloo.ca> Date: Sat, 8 Apr 2017 13:36:26 -0400 Subject: [PATCH] build-system/asdf: Handle all asdf dependency specifications. Add support for dependencies of the form (:version <name> <version>), (:feature <feature> <dependency-specification>) and (:require <module-name>), as defined by <https://common-lisp.net/project/asdf/asdf.html#The-defsystem-grammar>. * guix/build/lisp-utils.scm (normalize-dependency): New variable. (make-asd-file)[dependencies]: Use it to generate dependencies with normalized names. [dependency-name]: New variable. [registry]: Use it to flatten the normalized dependencies. --- guix/build/lisp-utils.scm | 26 ++++++++++++++++++++++++-- 1 file changed, 24 insertions(+), 2 deletions(-) diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm index 21cb620d5..3a7afab43 100644 --- a/guix/build/lisp-utils.scm +++ b/guix/build/lisp-utils.scm @@ -81,6 +81,20 @@ "Replace invalid characters in STR with a hyphen." (string-join (string-tokenize str valid-char-set) "-")) +(define (normalize-dependency dependency) + "Normalize the name of DEPENDENCY. Handles dependency definitions of the +dependency-def form described by +<https://common-lisp.net/project/asdf/asdf.html#The-defsystem-grammar>." + (match dependency + ((':version name rest ...) + `(:version ,(normalize-string name) ,@rest)) + ((':feature feature-specification dependency-specification) + `(:feature + ,feature-specification + ,(normalize-dependency dependency-specification))) + ((? string? name) (normalize-string name)) + (require-specification require-specification))) + (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." @@ -273,16 +287,24 @@ system to find its dependencies, as described by GENERATE-DEPENDENCY-LINKS." (system-dependencies system system-asd-file))) (if (eq? 'NIL deps) '() - (map normalize-string deps)))) + (map normalize-dependency deps)))) (define lisp-input-map (inputs->asd-file-map inputs)) + (define dependency-name + (match-lambda + ((':version name _ ...) name) + ((':feature _ dependency-specification) + (dependency-name dependency-specification)) + ((? string? name) name) + (_ #f))) + (define registry (filter-map hash-get-handle (make-list (length dependencies) lisp-input-map) - dependencies)) + (map dependency-name dependencies))) (call-with-output-file asd-file (lambda (port) -- 2.13.0
Debbugs Internal Request <help-debbugs <at> gnu.org>
to internal_control <at> debbugs.gnu.org
.
(Mon, 19 Jun 2017 11:24:04 GMT) Full text and rfc822 format available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.