[bug#32582] [PATCH 0/5] Fix slynk on sbcl.

[bug#32582] [PATCH 0/5] Fix slynk on sbcl.

[Andy Patterson]

Hey all,

Here are some changes to the asdf build system and the slynk package
with the aim of fixing slynk's build on sbcl.

Let me know what you think.

Thanks,

--
Andy

[bug#32582] [PATCH 1/5] build-system/asdf: Handle all asdf dependency specifications.

[Andy Patterson]

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.18.0

[bug#32582] [PATCH 2/5] build-system/asdf: Log lisp system invocations.

[Andy Patterson]

* guix/build/lisp-system.scm: (lisp-eval-program): Log the arguments to
system*.
---
 guix/build/lisp-utils.scm | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm
index 3a7afab43..9cf479dac 100644
--- a/guix/build/lisp-utils.scm
+++ b/guix/build/lisp-utils.scm
@@ -119,9 +119,10 @@ 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-invocation program)))
-    (error "lisp-eval-program failed!" (%lisp) program)))
+  (define invocation (lisp-invocation program))
+  (format #t "Invoking ~a: ~{~s ~}~%" (%lisp-type) invocation)
+  (unless (zero? (apply system* invocation))
+    (error "lisp-eval-program failed!" invocation)))
 
 (define (spread-statements program argument-name)
   "Return a list with the statements from PROGRAM spread between
-- 
2.18.0

[bug#32582] [PATCH 3/5] build-system/asdf: Use invoke.

[Andy Patterson]

* guix/build/lisp-utils.scm (lisp-eval-program): Replace system* and error
handling with invoke.
---
 guix/build/lisp-utils.scm | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm
index 9cf479dac..7c0a68ca9 100644
--- a/guix/build/lisp-utils.scm
+++ b/guix/build/lisp-utils.scm
@@ -121,8 +121,7 @@ name of an ASD system, and asd-file is the full path to its definition."
   "Evaluate PROGRAM with a given LISP implementation."
   (define invocation (lisp-invocation program))
   (format #t "Invoking ~a: ~{~s ~}~%" (%lisp-type) invocation)
-  (unless (zero? (apply system* invocation))
-    (error "lisp-eval-program failed!" invocation)))
+  (apply invoke invocation))
 
 (define (spread-statements program argument-name)
   "Return a list with the statements from PROGRAM spread between
-- 
2.18.0

[bug#32582] [PATCH 4/5] build-system/asdf: Adopt asdf conventions.

[Andy Patterson]

The asdf documentation specifies that asdf:load-asd should be preferred to
calling load on a system definition file.

* guix/build/lisp-utils.scm (compile-system): Replace load with asdf:load-asd.
(system-dependencies): Likewise.
(test-system): Likewise.
---
 guix/build/lisp-utils.scm | 31 ++++++++++++++-----------------
 1 file changed, 14 insertions(+), 17 deletions(-)

diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm
index 7c0a68ca9..6470cfec9 100644
--- a/guix/build/lisp-utils.scm
+++ b/guix/build/lisp-utils.scm
@@ -152,8 +152,7 @@ with PROGRAM."
 first."
   (lisp-eval-program
    `((require :asdf)
-     (let ((*package* (find-package :asdf)))
-       (load ,asd-file))
+     (asdf:load-asd (truename ,asd-file) :name ,(normalize-string system))
      (asdf:operate 'asdf:compile-bundle-op ,system))))
 
 (define (system-dependencies system asd-file)
@@ -162,8 +161,7 @@ asdf:system-depends-on.  First load the system's ASD-FILE."
   (define deps-file ".deps.sexp")
   (define program
     `((require :asdf)
-      (let ((*package* (find-package :asdf)))
-        (load ,asd-file))
+      (asdf:load-asd (truename ,asd-file) :name ,(normalize-string system))
       (with-open-file
        (stream ,deps-file :direction :output)
        (format stream
@@ -203,19 +201,18 @@ asdf:system-depends-on.  First load the system's ASD-FILE."
 Also load TEST-ASD-FILE if necessary."
   (lisp-eval-program
    `((require :asdf)
-     (let ((*package* (find-package :asdf)))
-       (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:load-asd (truename ,asd-file) :name ,(normalize-string system))
+     ,@(if test-asd-file
+           `((asdf:load-asd (truename ,test-asd-file)))
+           ;; Try some likely files.
+           (map (lambda (file)
+                  `(when (uiop:file-exists-p ,file)
+                     (asdf:load-asd (truename ,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.18.0

[bug#32582] [PATCH 5/5] gnu: sbcl-slynk: Fix the build.

[Andy Patterson]

* gnu/packages/lisp.scm (sbcl-slynk-boot0): Update to commit
cbf84c36c4eca8b032e3fd16177a7bc02df3ec4c.
[origin]<snippet>: Replace slynk/util references with the built system name
slynk-util. Remove compile-time invocations of slynk-require.
(sbcl-slynk-util): Inherit from sbcl-slynk-boot0.
[inputs]: Add sbcl-slynk-boot0.
[arguments]: Set an appropriate asd-file and asd-system-name.
(sbcl-slynk-arglists)[arguments]: Set an appropriate asdf-system-name.
(sbcl-slynk-fancy-inspector)[arguments]: Likewise.
(sbcl-slynk-package-fu)[arguments]: Likewise.
(sbcl-slynk-mrepl)[arguments]: Likewise.
(sbcl-slynk-trace-dialog)[arguments]: Likewise.
(sbcl-slynk-profiler)[arguments]: Likewise.
(sbcl-slynk-indentation)[arguments]: Likewise.
(sbcl-slynk-retro)[arguments]: Likewise.
---
 gnu/packages/lisp.scm | 68 ++++++++++++++++++++++++++++++++-----------
 1 file changed, 51 insertions(+), 17 deletions(-)

diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm
index 720ac070c..c4a92a220 100644
--- a/gnu/packages/lisp.scm
+++ b/gnu/packages/lisp.scm
@@ -1009,8 +1009,8 @@ productive, customizable lisp based systems.")
 ;; 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"))
+  (let ((revision "2")
+        (commit "cbf84c36c4eca8b032e3fd16177a7bc02df3ec4c"))
     (package
       (name "sbcl-slynk-boot0")
       (version (string-append "1.0.0-beta-" revision "." (string-take commit 7)))
@@ -1022,7 +1022,7 @@ productive, customizable lisp based systems.")
            (url "https://github.com/joaotavora/sly.git")
            (commit commit)))
          (sha256
-          (base32 "0h4gg3sndl2bf6jdnx9nrf14p9hhi43hagrl0f4v4l11hczl8w81"))
+          (base32 "13dyhsravn591p7g6is01mp2ynzjnnj7pwgi57r6xqmd4611y9vh"))
          (file-name (string-append "slynk-" version "-checkout"))
          (modules '((guix build utils)
                     (ice-9 ftw)))
@@ -1033,14 +1033,19 @@ productive, customizable lisp based systems.")
              (substitute* "slynk/slynk.asd"
                (("\\.\\./contrib")
                 "contrib")
-               (("\\(defsystem :slynk-util")
-                "(defsystem :slynk-util :depends-on (:slynk)"))
+               (("\\(defsystem :slynk/util")
+                "(defsystem :slynk/util :depends-on (:slynk)")
+               ((":depends-on \\(:slynk :slynk/util\\)")
+                ":depends-on (:slynk :slynk-util)"))
              (substitute* "contrib/slynk-trace-dialog.lisp"
                (("\\(slynk::reset-inspector\\)") ; Causes problems on load
                 "nil"))
              (substitute* "contrib/slynk-profiler.lisp"
                (("slynk:to-line")
                 "slynk-pprint-to-line"))
+             (substitute* "contrib/slynk-fancy-inspector.lisp"
+               (("slynk/util") "slynk-util")
+               ((":compile-toplevel :load-toplevel") ""))
              (rename-file "contrib" "slynk/contrib")
              ;; Move slynk's contents into the base directory for easier
              ;; access
@@ -1080,15 +1085,20 @@ multiple inspectors with independent history.")
     (arguments
      (substitute-keyword-arguments (package-arguments sbcl-slynk-boot0)
        ((#:asd-file _ "") "slynk.asd")
-       ((#:asd-system-name _ #f) #f)))))
+       ((#:asd-system-name _ #f) "slynk/arglists")))))
 
 (define ecl-slynk-arglists
   (sbcl-package->ecl-package sbcl-slynk-arglists))
 
 (define sbcl-slynk-util
   (package
-    (inherit sbcl-slynk-arglists)
-    (name "sbcl-slynk-util")))
+    (inherit sbcl-slynk-boot0)
+    (name "sbcl-slynk-util")
+    (inputs `(("slynk" ,sbcl-slynk-boot0)))
+    (arguments
+     (substitute-keyword-arguments (package-arguments sbcl-slynk-boot0)
+       ((#:asd-file _ "") "slynk.asd")
+       ((#:asd-system-name _ #f) "slynk/util")))))
 
 (define ecl-slynk-util
   (sbcl-package->ecl-package sbcl-slynk-util))
@@ -1098,7 +1108,10 @@ multiple inspectors with independent history.")
     (inherit sbcl-slynk-arglists)
     (name "sbcl-slynk-fancy-inspector")
     (inputs `(("slynk-util" ,sbcl-slynk-util)
-              ,@(package-inputs sbcl-slynk-arglists)))))
+              ,@(package-inputs sbcl-slynk-arglists)))
+    (arguments
+     (substitute-keyword-arguments (package-arguments sbcl-slynk-arglists)
+       ((#:asd-system-name _ #f) "slynk/fancy-inspector")))))
 
 (define ecl-slynk-fancy-inspector
   (sbcl-package->ecl-package sbcl-slynk-fancy-inspector))
@@ -1106,15 +1119,21 @@ multiple inspectors with independent history.")
 (define sbcl-slynk-package-fu
   (package
     (inherit sbcl-slynk-arglists)
-    (name "sbcl-slynk-package-fu")))
+    (name "sbcl-slynk-package-fu")
+    (arguments
+     (substitute-keyword-arguments (package-arguments sbcl-slynk-arglists)
+       ((#:asd-system-name _ #f) "slynk/package-fu")))))
 
 (define ecl-slynk-package-fu
   (sbcl-package->ecl-package sbcl-slynk-package-fu))
 
 (define sbcl-slynk-mrepl
   (package
-    (inherit sbcl-slynk-arglists)
-    (name "sbcl-slynk-mrepl")))
+    (inherit sbcl-slynk-fancy-inspector)
+    (name "sbcl-slynk-mrepl")
+    (arguments
+     (substitute-keyword-arguments (package-arguments sbcl-slynk-arglists)
+       ((#:asd-system-name _ #f) "slynk/mrepl")))))
 
 (define ecl-slynk-mrepl
   (sbcl-package->ecl-package sbcl-slynk-mrepl))
@@ -1122,7 +1141,10 @@ multiple inspectors with independent history.")
 (define sbcl-slynk-trace-dialog
   (package
     (inherit sbcl-slynk-arglists)
-    (name "sbcl-slynk-trace-dialog")))
+    (name "sbcl-slynk-trace-dialog")
+    (arguments
+     (substitute-keyword-arguments (package-arguments sbcl-slynk-arglists)
+       ((#:asd-system-name _ #f) "slynk/trace-dialog")))))
 
 (define ecl-slynk-trace-dialog
   (sbcl-package->ecl-package sbcl-slynk-trace-dialog))
@@ -1130,7 +1152,10 @@ multiple inspectors with independent history.")
 (define sbcl-slynk-profiler
   (package
     (inherit sbcl-slynk-arglists)
-    (name "sbcl-slynk-profiler")))
+    (name "sbcl-slynk-profiler")
+    (arguments
+     (substitute-keyword-arguments (package-arguments sbcl-slynk-arglists)
+       ((#:asd-system-name _ #f) "slynk/profiler")))))
 
 (define ecl-slynk-profiler
   (sbcl-package->ecl-package sbcl-slynk-profiler))
@@ -1138,7 +1163,10 @@ multiple inspectors with independent history.")
 (define sbcl-slynk-stickers
   (package
     (inherit sbcl-slynk-arglists)
-    (name "sbcl-slynk-stickers")))
+    (name "sbcl-slynk-stickers")
+    (arguments
+     (substitute-keyword-arguments (package-arguments sbcl-slynk-arglists)
+       ((#:asd-system-name _ #f) "slynk/stickers")))))
 
 (define ecl-slynk-stickers
   (sbcl-package->ecl-package sbcl-slynk-stickers))
@@ -1146,7 +1174,10 @@ multiple inspectors with independent history.")
 (define sbcl-slynk-indentation
   (package
     (inherit sbcl-slynk-arglists)
-    (name "sbcl-slynk-indentation")))
+    (name "sbcl-slynk-indentation")
+    (arguments
+     (substitute-keyword-arguments (package-arguments sbcl-slynk-arglists)
+       ((#:asd-system-name _ #f) "slynk/indentation")))))
 
 (define ecl-slynk-indentation
   (sbcl-package->ecl-package sbcl-slynk-indentation))
@@ -1154,7 +1185,10 @@ multiple inspectors with independent history.")
 (define sbcl-slynk-retro
   (package
     (inherit sbcl-slynk-arglists)
-    (name "sbcl-slynk-retro")))
+    (name "sbcl-slynk-retro")
+    (arguments
+     (substitute-keyword-arguments (package-arguments sbcl-slynk-arglists)
+       ((#:asd-system-name _ #f) "slynk/retro")))))
 
 (define ecl-slynk-retro
   (sbcl-package->ecl-package sbcl-slynk-retro))
-- 
2.18.0

[bug#32582] [PATCH 0/5] Fix slynk on sbcl.

[Andy Patterson]

Hi,

On Thu, 30 Aug 2018 01:28:13 -0400
Andy Patterson <ajpatter@uwaterloo.ca> wrote:

> Hey all,
> 
> Here are some changes to the asdf build system and the slynk package
> with the aim of fixing slynk's build on sbcl.


Ping =).

Thanks in advance,

--
Andy

bug#32582: [PATCH 0/5] Fix slynk on sbcl.

[Ludovic Courtès]

Hi Andy,

Andy Patterson <ajpatter@uwaterloo.ca> skribis:

> Hi,
>
> On Thu, 30 Aug 2018 01:28:13 -0400
> Andy Patterson <ajpatter@uwaterloo.ca> wrote:
>
>> Hey all,
>> 
>> Here are some changes to the asdf build system and the slynk package
>> with the aim of fixing slynk's build on sbcl.
>
>
> Ping =).

Oops, it was about to fall through the cracks.  :-)

It LGTM so I’ve pushed all 5 patches.

Thank you, and sorry for the delay!

Ludo’.