all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* bug#26346: [PATCH] asdf-build-system improvements.
@ 2017-04-03  4:37 Andy Patterson
  2017-04-03 13:01 ` bug#26346: [PATCH 01/17] gnu: cl-slynk: Clarify the description Andy Patterson
                   ` (3 more replies)
  0 siblings, 4 replies; 29+ messages in thread
From: Andy Patterson @ 2017-04-03  4:37 UTC (permalink / raw)
  To: 26346

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

^ permalink raw reply	[flat|nested] 29+ messages in thread

* bug#26346: [PATCH 01/17] gnu: cl-slynk: Clarify the description.
  2017-04-03  4:37 bug#26346: [PATCH] asdf-build-system improvements Andy Patterson
@ 2017-04-03 13:01 ` Andy Patterson
  2017-04-03 13:01   ` bug#26346: [PATCH 02/17] gnu: cl-slynk: Explain some naming choices Andy Patterson
                     ` (15 more replies)
  2017-04-09  3:43 ` bug#26346: [PATCH 18/20] build-system/asdf: Handle tests defined in external systems Andy Patterson
                   ` (2 subsequent siblings)
  3 siblings, 16 replies; 29+ messages in thread
From: Andy Patterson @ 2017-04-03 13:01 UTC (permalink / raw)
  To: 26346

* 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@netris.org>
 ;;; Copyright © 2016 Federico Beffa <beffa@fbengineering.ch>
 ;;; Copyright © 2016, 2017 ng0 <contact.ng0@cryptolab.net>
-;;; Copyright © 2016 Andy Patterson <ajpatter@uwaterloo.ca>
+;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca>
 ;;; Copyright © 2017 Ricardo Wurmus <rekado@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

^ permalink raw reply related	[flat|nested] 29+ messages in thread

* bug#26346: [PATCH 02/17] gnu: cl-slynk: Explain some naming choices.
  2017-04-03 13:01 ` bug#26346: [PATCH 01/17] gnu: cl-slynk: Clarify the description Andy Patterson
@ 2017-04-03 13:01   ` Andy Patterson
  2017-04-03 13:01   ` bug#26346: [PATCH 03/17] build-system/asdf: Rename %install-prefix to %source-install-prefix Andy Patterson
                     ` (14 subsequent siblings)
  15 siblings, 0 replies; 29+ messages in thread
From: Andy Patterson @ 2017-04-03 13:01 UTC (permalink / raw)
  To: 26346

* 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

^ permalink raw reply related	[flat|nested] 29+ messages in thread

* bug#26346: [PATCH 03/17] build-system/asdf: Rename %install-prefix to %source-install-prefix.
  2017-04-03 13:01 ` bug#26346: [PATCH 01/17] gnu: cl-slynk: Clarify the description Andy Patterson
  2017-04-03 13:01   ` bug#26346: [PATCH 02/17] gnu: cl-slynk: Explain some naming choices Andy Patterson
@ 2017-04-03 13:01   ` Andy Patterson
  2017-04-03 13:01   ` bug#26346: [PATCH 04/17] build-system/asdf: Make it possible to use "lib" as the build output Andy Patterson
                     ` (13 subsequent siblings)
  15 siblings, 0 replies; 29+ messages in thread
From: Andy Patterson @ 2017-04-03 13:01 UTC (permalink / raw)
  To: 26346

* 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@uwaterloo.ca>
+;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@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@uwaterloo.ca>
+;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@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

^ permalink raw reply related	[flat|nested] 29+ messages in thread

* bug#26346: [PATCH 04/17] build-system/asdf: Make it possible to use "lib" as the build output.
  2017-04-03 13:01 ` bug#26346: [PATCH 01/17] gnu: cl-slynk: Clarify the description Andy Patterson
  2017-04-03 13:01   ` bug#26346: [PATCH 02/17] gnu: cl-slynk: Explain some naming choices Andy Patterson
  2017-04-03 13:01   ` bug#26346: [PATCH 03/17] build-system/asdf: Rename %install-prefix to %source-install-prefix Andy Patterson
@ 2017-04-03 13:01   ` Andy Patterson
  2017-04-03 13:01   ` bug#26346: [PATCH 05/17] gnu: cl-stumpwm: Build the library in "lib" and the program in "bin" Andy Patterson
                     ` (12 subsequent siblings)
  15 siblings, 0 replies; 29+ messages in thread
From: Andy Patterson @ 2017-04-03 13:01 UTC (permalink / raw)
  To: 26346

* 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

^ permalink raw reply related	[flat|nested] 29+ messages in thread

* bug#26346: [PATCH 05/17] gnu: cl-stumpwm: Build the library in "lib" and the program in "bin".
  2017-04-03 13:01 ` bug#26346: [PATCH 01/17] gnu: cl-slynk: Clarify the description Andy Patterson
                     ` (2 preceding siblings ...)
  2017-04-03 13:01   ` bug#26346: [PATCH 04/17] build-system/asdf: Make it possible to use "lib" as the build output Andy Patterson
@ 2017-04-03 13:01   ` Andy Patterson
  2017-04-03 13:01   ` bug#26346: [PATCH 06/17] build-system/asdf: Use asdf to determine dependencies Andy Patterson
                     ` (11 subsequent siblings)
  15 siblings, 0 replies; 29+ messages in thread
From: Andy Patterson @ 2017-04-03 13:01 UTC (permalink / raw)
  To: 26346

* 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

^ permalink raw reply related	[flat|nested] 29+ messages in thread

* bug#26346: [PATCH 06/17] build-system/asdf: Use asdf to determine dependencies.
  2017-04-03 13:01 ` bug#26346: [PATCH 01/17] gnu: cl-slynk: Clarify the description Andy Patterson
                     ` (3 preceding siblings ...)
  2017-04-03 13:01   ` bug#26346: [PATCH 05/17] gnu: cl-stumpwm: Build the library in "lib" and the program in "bin" Andy Patterson
@ 2017-04-03 13:01   ` Andy Patterson
  2017-04-03 13:01   ` bug#26346: [PATCH 07/17] build-system/asdf: Don't rename inputs Andy Patterson
                     ` (10 subsequent siblings)
  15 siblings, 0 replies; 29+ messages in thread
From: Andy Patterson @ 2017-04-03 13:01 UTC (permalink / raw)
  To: 26346

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

^ permalink raw reply related	[flat|nested] 29+ messages in thread

* bug#26346: [PATCH 07/17] build-system/asdf: Don't rename inputs.
  2017-04-03 13:01 ` bug#26346: [PATCH 01/17] gnu: cl-slynk: Clarify the description Andy Patterson
                     ` (4 preceding siblings ...)
  2017-04-03 13:01   ` bug#26346: [PATCH 06/17] build-system/asdf: Use asdf to determine dependencies Andy Patterson
@ 2017-04-03 13:01   ` Andy Patterson
  2017-04-03 13:01   ` bug#26346: [PATCH 08/17] build-system/asdf: Keep ecl's generated archive files Andy Patterson
                     ` (9 subsequent siblings)
  15 siblings, 0 replies; 29+ messages in thread
From: Andy Patterson @ 2017-04-03 13:01 UTC (permalink / raw)
  To: 26346

* 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@uwaterloo.ca>
+;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@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

^ permalink raw reply related	[flat|nested] 29+ messages in thread

* bug#26346: [PATCH 08/17] build-system/asdf: Keep ecl's generated archive files.
  2017-04-03 13:01 ` bug#26346: [PATCH 01/17] gnu: cl-slynk: Clarify the description Andy Patterson
                     ` (5 preceding siblings ...)
  2017-04-03 13:01   ` bug#26346: [PATCH 07/17] build-system/asdf: Don't rename inputs Andy Patterson
@ 2017-04-03 13:01   ` Andy Patterson
  2017-04-03 13:01   ` bug#26346: [PATCH 09/17] build-system/asdf: Make #:lisp a package argument Andy Patterson
                     ` (8 subsequent siblings)
  15 siblings, 0 replies; 29+ messages in thread
From: Andy Patterson @ 2017-04-03 13:01 UTC (permalink / raw)
  To: 26346

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

^ permalink raw reply related	[flat|nested] 29+ messages in thread

* bug#26346: [PATCH 09/17] build-system/asdf: Make #:lisp a package argument.
  2017-04-03 13:01 ` bug#26346: [PATCH 01/17] gnu: cl-slynk: Clarify the description Andy Patterson
                     ` (6 preceding siblings ...)
  2017-04-03 13:01   ` bug#26346: [PATCH 08/17] build-system/asdf: Keep ecl's generated archive files Andy Patterson
@ 2017-04-03 13:01   ` Andy Patterson
  2017-04-03 13:01   ` bug#26346: [PATCH 10/17] build-system/asdf: Parameterize the lisp type and implementation globally Andy Patterson
                     ` (7 subsequent siblings)
  15 siblings, 0 replies; 29+ messages in thread
From: Andy Patterson @ 2017-04-03 13:01 UTC (permalink / raw)
  To: 26346

* 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

^ permalink raw reply related	[flat|nested] 29+ messages in thread

* bug#26346: [PATCH 10/17] build-system/asdf: Parameterize the lisp type and implementation globally.
  2017-04-03 13:01 ` bug#26346: [PATCH 01/17] gnu: cl-slynk: Clarify the description Andy Patterson
                     ` (7 preceding siblings ...)
  2017-04-03 13:01   ` bug#26346: [PATCH 09/17] build-system/asdf: Make #:lisp a package argument Andy Patterson
@ 2017-04-03 13:01   ` Andy Patterson
  2017-04-03 13:01   ` bug#26346: [PATCH 11/17] build-system/asdf: Pass the system name as an argument to the builder Andy Patterson
                     ` (6 subsequent siblings)
  15 siblings, 0 replies; 29+ messages in thread
From: Andy Patterson @ 2017-04-03 13:01 UTC (permalink / raw)
  To: 26346

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

^ permalink raw reply related	[flat|nested] 29+ messages in thread

* bug#26346: [PATCH 11/17] build-system/asdf: Pass the system name as an argument to the builder.
  2017-04-03 13:01 ` bug#26346: [PATCH 01/17] gnu: cl-slynk: Clarify the description Andy Patterson
                     ` (8 preceding siblings ...)
  2017-04-03 13:01   ` bug#26346: [PATCH 10/17] build-system/asdf: Parameterize the lisp type and implementation globally Andy Patterson
@ 2017-04-03 13:01   ` Andy Patterson
  2017-04-09  3:48     ` bug#26346: [PATCH v2 11/20] " Andy Patterson
  2017-04-03 13:01   ` bug#26346: [PATCH 12/17] build-system/asdf: Always pre-load the system's definition file Andy Patterson
                     ` (5 subsequent siblings)
  15 siblings, 1 reply; 29+ messages in thread
From: Andy Patterson @ 2017-04-03 13:01 UTC (permalink / raw)
  To: 26346

* 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

^ permalink raw reply related	[flat|nested] 29+ messages in thread

* bug#26346: [PATCH 12/17] build-system/asdf: Always pre-load the system's definition file.
  2017-04-03 13:01 ` bug#26346: [PATCH 01/17] gnu: cl-slynk: Clarify the description Andy Patterson
                     ` (9 preceding siblings ...)
  2017-04-03 13:01   ` bug#26346: [PATCH 11/17] build-system/asdf: Pass the system name as an argument to the builder Andy Patterson
@ 2017-04-03 13:01   ` Andy Patterson
  2017-04-03 13:01   ` bug#26346: [PATCH 13/17] build-system/asdf: Handle unusually-named systems Andy Patterson
                     ` (4 subsequent siblings)
  15 siblings, 0 replies; 29+ messages in thread
From: Andy Patterson @ 2017-04-03 13:01 UTC (permalink / raw)
  To: 26346

* 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

^ permalink raw reply related	[flat|nested] 29+ messages in thread

* bug#26346: [PATCH 13/17] build-system/asdf: Handle unusually-named systems.
  2017-04-03 13:01 ` bug#26346: [PATCH 01/17] gnu: cl-slynk: Clarify the description Andy Patterson
                     ` (10 preceding siblings ...)
  2017-04-03 13:01   ` bug#26346: [PATCH 12/17] build-system/asdf: Always pre-load the system's definition file Andy Patterson
@ 2017-04-03 13:01   ` Andy Patterson
  2017-04-03 13:01   ` bug#26346: [PATCH 14/17] gnu: Add cl-unicode Andy Patterson
                     ` (3 subsequent siblings)
  15 siblings, 0 replies; 29+ messages in thread
From: Andy Patterson @ 2017-04-03 13:01 UTC (permalink / raw)
  To: 26346

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

^ permalink raw reply related	[flat|nested] 29+ messages in thread

* bug#26346: [PATCH 14/17] gnu: Add cl-unicode.
  2017-04-03 13:01 ` bug#26346: [PATCH 01/17] gnu: cl-slynk: Clarify the description Andy Patterson
                     ` (11 preceding siblings ...)
  2017-04-03 13:01   ` bug#26346: [PATCH 13/17] build-system/asdf: Handle unusually-named systems Andy Patterson
@ 2017-04-03 13:01   ` Andy Patterson
  2017-04-03 13:01   ` bug#26346: [PATCH 15/17] build-system/asdf: Simplify the use of lisp-eval-program Andy Patterson
                     ` (2 subsequent siblings)
  15 siblings, 0 replies; 29+ messages in thread
From: Andy Patterson @ 2017-04-03 13:01 UTC (permalink / raw)
  To: 26346; +Cc: Ricardo Wurmus

From: Ricardo Wurmus <rekado@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@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

^ permalink raw reply related	[flat|nested] 29+ messages in thread

* bug#26346: [PATCH 15/17] build-system/asdf: Simplify the use of lisp-eval-program.
  2017-04-03 13:01 ` bug#26346: [PATCH 01/17] gnu: cl-slynk: Clarify the description Andy Patterson
                     ` (12 preceding siblings ...)
  2017-04-03 13:01   ` bug#26346: [PATCH 14/17] gnu: Add cl-unicode Andy Patterson
@ 2017-04-03 13:01   ` Andy Patterson
  2017-04-03 13:01   ` bug#26346: [PATCH 16/17] build-system/asdf: Retain references to source files for binary outputs Andy Patterson
  2017-04-03 13:01   ` bug#26346: [PATCH 17/17] gnu: sbcl-slynk-boot0: Give the package an appropriate name Andy Patterson
  15 siblings, 0 replies; 29+ messages in thread
From: Andy Patterson @ 2017-04-03 13:01 UTC (permalink / raw)
  To: 26346

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

^ permalink raw reply related	[flat|nested] 29+ messages in thread

* bug#26346: [PATCH 16/17] build-system/asdf: Retain references to source files for binary outputs.
  2017-04-03 13:01 ` bug#26346: [PATCH 01/17] gnu: cl-slynk: Clarify the description Andy Patterson
                     ` (13 preceding siblings ...)
  2017-04-03 13:01   ` bug#26346: [PATCH 15/17] build-system/asdf: Simplify the use of lisp-eval-program Andy Patterson
@ 2017-04-03 13:01   ` Andy Patterson
  2017-05-16  7:02     ` Ricardo Wurmus
  2017-04-03 13:01   ` bug#26346: [PATCH 17/17] gnu: sbcl-slynk-boot0: Give the package an appropriate name Andy Patterson
  15 siblings, 1 reply; 29+ messages in thread
From: Andy Patterson @ 2017-04-03 13:01 UTC (permalink / raw)
  To: 26346

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

^ permalink raw reply related	[flat|nested] 29+ messages in thread

* bug#26346: [PATCH 17/17] gnu: sbcl-slynk-boot0: Give the package an appropriate name.
  2017-04-03 13:01 ` bug#26346: [PATCH 01/17] gnu: cl-slynk: Clarify the description Andy Patterson
                     ` (14 preceding siblings ...)
  2017-04-03 13:01   ` bug#26346: [PATCH 16/17] build-system/asdf: Retain references to source files for binary outputs Andy Patterson
@ 2017-04-03 13:01   ` Andy Patterson
  2017-04-09  3:50     ` bug#26346: [PATCH v2 17/20] " Andy Patterson
  15 siblings, 1 reply; 29+ messages in thread
From: Andy Patterson @ 2017-04-03 13:01 UTC (permalink / raw)
  To: 26346

* 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

^ permalink raw reply related	[flat|nested] 29+ messages in thread

* bug#26346: [PATCH 18/20] build-system/asdf: Handle tests defined in external systems.
  2017-04-03  4:37 bug#26346: [PATCH] asdf-build-system improvements Andy Patterson
  2017-04-03 13:01 ` bug#26346: [PATCH 01/17] gnu: cl-slynk: Clarify the description Andy Patterson
@ 2017-04-09  3:43 ` Andy Patterson
  2017-04-09  3:43   ` bug#26346: [PATCH 19/20] build-system/asdf: Handle versioned asdf dependencies Andy Patterson
  2017-04-09  3:43   ` bug#26346: [PATCH 20/20] doc: Update the documentation for the asdf build systems Andy Patterson
  2017-04-09  3:58 ` bug#26346: [PATCH] asdf-build-system improvements Andy Patterson
  2017-05-16 13:19 ` Ricardo Wurmus
  3 siblings, 2 replies; 29+ messages in thread
From: Andy Patterson @ 2017-04-09  3:43 UTC (permalink / raw)
  To: 26346

* 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

^ permalink raw reply related	[flat|nested] 29+ messages in thread

* bug#26346: [PATCH 19/20] build-system/asdf: Handle versioned asdf dependencies.
  2017-04-09  3:43 ` bug#26346: [PATCH 18/20] build-system/asdf: Handle tests defined in external systems Andy Patterson
@ 2017-04-09  3:43   ` Andy Patterson
  2017-05-16  8:17     ` Ricardo Wurmus
  2017-04-09  3:43   ` bug#26346: [PATCH 20/20] doc: Update the documentation for the asdf build systems Andy Patterson
  1 sibling, 1 reply; 29+ messages in thread
From: Andy Patterson @ 2017-04-09  3:43 UTC (permalink / raw)
  To: 26346

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

^ permalink raw reply related	[flat|nested] 29+ messages in thread

* bug#26346: [PATCH 20/20] doc: Update the documentation for the asdf build systems.
  2017-04-09  3:43 ` bug#26346: [PATCH 18/20] build-system/asdf: Handle tests defined in external systems Andy Patterson
  2017-04-09  3:43   ` bug#26346: [PATCH 19/20] build-system/asdf: Handle versioned asdf dependencies Andy Patterson
@ 2017-04-09  3:43   ` Andy Patterson
  1 sibling, 0 replies; 29+ messages in thread
From: Andy Patterson @ 2017-04-09  3:43 UTC (permalink / raw)
  To: 26346

* 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

^ permalink raw reply related	[flat|nested] 29+ messages in thread

* bug#26346: [PATCH v2 11/20] build-system/asdf: Pass the system name as an argument to the builder.
  2017-04-03 13:01   ` bug#26346: [PATCH 11/17] build-system/asdf: Pass the system name as an argument to the builder Andy Patterson
@ 2017-04-09  3:48     ` Andy Patterson
  0 siblings, 0 replies; 29+ messages in thread
From: Andy Patterson @ 2017-04-09  3:48 UTC (permalink / raw)
  To: 26346

From 81f4bee23f9b11e549284877319ff43e8595f2dc Mon Sep 17 00:00:00 2001
From: Andy Patterson <ajpatter@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

^ permalink raw reply related	[flat|nested] 29+ messages in thread

* bug#26346: [PATCH v2 17/20] gnu: sbcl-slynk-boot0: Give the package an appropriate name.
  2017-04-03 13:01   ` bug#26346: [PATCH 17/17] gnu: sbcl-slynk-boot0: Give the package an appropriate name Andy Patterson
@ 2017-04-09  3:50     ` Andy Patterson
  0 siblings, 0 replies; 29+ messages in thread
From: Andy Patterson @ 2017-04-09  3:50 UTC (permalink / raw)
  To: 26346

From 7fd6d035a8f97b085b3de50ae04ec570538ff283 Mon Sep 17 00:00:00 2001
From: Andy Patterson <ajpatter@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

^ permalink raw reply related	[flat|nested] 29+ messages in thread

* bug#26346: [PATCH] asdf-build-system improvements.
  2017-04-03  4:37 bug#26346: [PATCH] asdf-build-system improvements Andy Patterson
  2017-04-03 13:01 ` bug#26346: [PATCH 01/17] gnu: cl-slynk: Clarify the description Andy Patterson
  2017-04-09  3:43 ` bug#26346: [PATCH 18/20] build-system/asdf: Handle tests defined in external systems Andy Patterson
@ 2017-04-09  3:58 ` Andy Patterson
  2017-05-16 13:19 ` Ricardo Wurmus
  3 siblings, 0 replies; 29+ messages in thread
From: Andy Patterson @ 2017-04-09  3:58 UTC (permalink / raw)
  To: 26346

I've added some further changes to make sure everything works (whoops).

--
Andy

^ permalink raw reply	[flat|nested] 29+ messages in thread

* bug#26346: [PATCH 16/17] build-system/asdf: Retain references to source files for binary outputs.
  2017-04-03 13:01   ` bug#26346: [PATCH 16/17] build-system/asdf: Retain references to source files for binary outputs Andy Patterson
@ 2017-05-16  7:02     ` Ricardo Wurmus
  0 siblings, 0 replies; 29+ messages in thread
From: Ricardo Wurmus @ 2017-05-16  7:02 UTC (permalink / raw)
  To: Andy Patterson; +Cc: 26346


Andy Patterson <ajpatter@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

^ permalink raw reply	[flat|nested] 29+ messages in thread

* bug#26346: [PATCH 19/20] build-system/asdf: Handle versioned asdf dependencies.
  2017-04-09  3:43   ` bug#26346: [PATCH 19/20] build-system/asdf: Handle versioned asdf dependencies Andy Patterson
@ 2017-05-16  8:17     ` Ricardo Wurmus
  2017-05-22  2:35       ` Andy Patterson
  0 siblings, 1 reply; 29+ messages in thread
From: Ricardo Wurmus @ 2017-05-16  8:17 UTC (permalink / raw)
  To: Andy Patterson; +Cc: 26346


Andy Patterson <ajpatter@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

^ permalink raw reply	[flat|nested] 29+ messages in thread

* Re: bug#26346: [PATCH] asdf-build-system improvements.
  2017-04-03  4:37 bug#26346: [PATCH] asdf-build-system improvements Andy Patterson
                   ` (2 preceding siblings ...)
  2017-04-09  3:58 ` bug#26346: [PATCH] asdf-build-system improvements Andy Patterson
@ 2017-05-16 13:19 ` Ricardo Wurmus
  2017-05-17 13:11   ` Ludovic Courtès
  3 siblings, 1 reply; 29+ messages in thread
From: Ricardo Wurmus @ 2017-05-16 13:19 UTC (permalink / raw)
  To: Andy Patterson; +Cc: guix-devel, 26346-done


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

^ permalink raw reply	[flat|nested] 29+ messages in thread

* bug#26346: [PATCH] asdf-build-system improvements.
  2017-05-16 13:19 ` Ricardo Wurmus
@ 2017-05-17 13:11   ` Ludovic Courtès
  0 siblings, 0 replies; 29+ messages in thread
From: Ludovic Courtès @ 2017-05-17 13:11 UTC (permalink / raw)
  To: 26346; +Cc: rekado

Ricardo Wurmus <rekado@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’.

^ permalink raw reply	[flat|nested] 29+ messages in thread

* bug#26346: [PATCH 19/20] build-system/asdf: Handle versioned asdf dependencies.
  2017-05-16  8:17     ` Ricardo Wurmus
@ 2017-05-22  2:35       ` Andy Patterson
  0 siblings, 0 replies; 29+ messages in thread
From: Andy Patterson @ 2017-05-22  2:35 UTC (permalink / raw)
  To: Ricardo Wurmus; +Cc: 26346

On Tue, 16 May 2017 10:17:14 +0200
Ricardo Wurmus <rekado@elephly.net> wrote:

> Andy Patterson <ajpatter@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@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

^ permalink raw reply related	[flat|nested] 29+ messages in thread

end of thread, other threads:[~2017-05-22  2:36 UTC | newest]

Thread overview: 29+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2017-04-03  4:37 bug#26346: [PATCH] asdf-build-system improvements Andy Patterson
2017-04-03 13:01 ` bug#26346: [PATCH 01/17] gnu: cl-slynk: Clarify the description Andy Patterson
2017-04-03 13:01   ` bug#26346: [PATCH 02/17] gnu: cl-slynk: Explain some naming choices Andy Patterson
2017-04-03 13:01   ` bug#26346: [PATCH 03/17] build-system/asdf: Rename %install-prefix to %source-install-prefix Andy Patterson
2017-04-03 13:01   ` bug#26346: [PATCH 04/17] build-system/asdf: Make it possible to use "lib" as the build output Andy Patterson
2017-04-03 13:01   ` bug#26346: [PATCH 05/17] gnu: cl-stumpwm: Build the library in "lib" and the program in "bin" Andy Patterson
2017-04-03 13:01   ` bug#26346: [PATCH 06/17] build-system/asdf: Use asdf to determine dependencies Andy Patterson
2017-04-03 13:01   ` bug#26346: [PATCH 07/17] build-system/asdf: Don't rename inputs Andy Patterson
2017-04-03 13:01   ` bug#26346: [PATCH 08/17] build-system/asdf: Keep ecl's generated archive files Andy Patterson
2017-04-03 13:01   ` bug#26346: [PATCH 09/17] build-system/asdf: Make #:lisp a package argument Andy Patterson
2017-04-03 13:01   ` bug#26346: [PATCH 10/17] build-system/asdf: Parameterize the lisp type and implementation globally Andy Patterson
2017-04-03 13:01   ` bug#26346: [PATCH 11/17] build-system/asdf: Pass the system name as an argument to the builder Andy Patterson
2017-04-09  3:48     ` bug#26346: [PATCH v2 11/20] " Andy Patterson
2017-04-03 13:01   ` bug#26346: [PATCH 12/17] build-system/asdf: Always pre-load the system's definition file Andy Patterson
2017-04-03 13:01   ` bug#26346: [PATCH 13/17] build-system/asdf: Handle unusually-named systems Andy Patterson
2017-04-03 13:01   ` bug#26346: [PATCH 14/17] gnu: Add cl-unicode Andy Patterson
2017-04-03 13:01   ` bug#26346: [PATCH 15/17] build-system/asdf: Simplify the use of lisp-eval-program Andy Patterson
2017-04-03 13:01   ` bug#26346: [PATCH 16/17] build-system/asdf: Retain references to source files for binary outputs Andy Patterson
2017-05-16  7:02     ` Ricardo Wurmus
2017-04-03 13:01   ` bug#26346: [PATCH 17/17] gnu: sbcl-slynk-boot0: Give the package an appropriate name Andy Patterson
2017-04-09  3:50     ` bug#26346: [PATCH v2 17/20] " Andy Patterson
2017-04-09  3:43 ` bug#26346: [PATCH 18/20] build-system/asdf: Handle tests defined in external systems Andy Patterson
2017-04-09  3:43   ` bug#26346: [PATCH 19/20] build-system/asdf: Handle versioned asdf dependencies Andy Patterson
2017-05-16  8:17     ` Ricardo Wurmus
2017-05-22  2:35       ` Andy Patterson
2017-04-09  3:43   ` bug#26346: [PATCH 20/20] doc: Update the documentation for the asdf build systems Andy Patterson
2017-04-09  3:58 ` bug#26346: [PATCH] asdf-build-system improvements Andy Patterson
2017-05-16 13:19 ` Ricardo Wurmus
2017-05-17 13:11   ` Ludovic Courtès

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/guix.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.