unofficial mirror of guix-patches@gnu.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; 28+ 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] 28+ 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; 28+ 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] 28+ 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; 28+ 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] 28+ 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; 28+ 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] 28+ 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; 28+ 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] 28+ 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; 28+ 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] 28+ 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; 28+ 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] 28+ 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; 28+ 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] 28+ 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; 28+ 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] 28+ 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; 28+ 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] 28+ 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; 28+ 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] 28+ 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; 28+ 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] 28+ 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; 28+ 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] 28+ 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; 28+ 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] 28+ 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; 28+ 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] 28+ 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; 28+ 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] 28+ 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; 28+ 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] 28+ 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; 28+ 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] 28+ 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
       [not found] ` <874lwl548n.fsf@elephly.net>
  3 siblings, 2 replies; 28+ 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] 28+ 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; 28+ 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] 28+ 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; 28+ 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] 28+ 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; 28+ 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] 28+ 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; 28+ 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] 28+ 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
       [not found] ` <874lwl548n.fsf@elephly.net>
  3 siblings, 0 replies; 28+ 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] 28+ 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; 28+ 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] 28+ 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; 28+ 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] 28+ messages in thread

* bug#26346: [PATCH] asdf-build-system improvements.
       [not found] ` <874lwl548n.fsf@elephly.net>
@ 2017-05-17 13:11   ` Ludovic Courtès
  0 siblings, 0 replies; 28+ 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] 28+ 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; 28+ 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] 28+ messages in thread

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

Thread overview: 28+ 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
     [not found] ` <874lwl548n.fsf@elephly.net>
2017-05-17 13:11   ` Ludovic Courtès

Code repositories for project(s) associated with this public inbox

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

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).