From 114b40ed675d0543058b5bdea86e561eff7c6b6e Mon Sep 17 00:00:00 2001
From: Pierre Neidhardt <mail@ambrevar.xyz>
Date: Fri, 8 Jul 2022 19:19:13 +0200
Subject: [PATCH] gnu: cl-slime-swank: Store .fasl in the ASDF registry.

* gnu/packages/lisp-xyz.scm (sbcl-slime-swank)[arguments]: Patch swank.asd to
store the .fasl in the ASDF registry so that they are found in the
package.
Also patch swank-loader.lisp so that it does not try to remove the .fasl from
the store.

(cl-slime-swank)[arguments]: Revert above patch of the swank.ask so that the
source package does not get bound to the SBCL package.

We would not have to do this if SLIME/Swank used ASDF properly instead of
working around it.
---
 gnu/packages/lisp-xyz.scm | 42 +++++++++++++++++++++++++++++++++++++--
 1 file changed, 40 insertions(+), 2 deletions(-)

diff --git a/gnu/packages/lisp-xyz.scm b/gnu/packages/lisp-xyz.scm
index 705c68e10e..062de8c8e9 100644
--- a/gnu/packages/lisp-xyz.scm
+++ b/gnu/packages/lisp-xyz.scm
@@ -2302,7 +2302,31 @@ (define-public sbcl-slime-swank
              #t))))
     (build-system asdf-build-system/sbcl)
     (arguments
-     '(#:asd-systems '("swank")))
+     '(#:asd-systems '("swank")
+       #:phases
+       (modify-phases %standard-phases
+         (add-after 'unpack 'set-fasl-directory
+           (lambda* (#:key outputs #:allow-other-keys)
+             (let* ((out (assoc-ref outputs "out"))
+                    (lib-dir (string-append out "/lib/common-lisp/"
+                                            (%lisp-type)
+                                            "/slime-swank/")))
+               ;; Use the ASDF registry instead of Swank's default that places
+               ;; the .fasl files in ~/.slime.
+               (substitute* "swank.asd"
+                 (("\\(load \\(asdf::component-pathname f\\)\\)" all)
+                  (string-append
+                   all "\n"
+                   "(setf (symbol-value"
+                   "(read-from-string \"swank-loader::*fasl-directory*\"))"
+                   "\"" lib-dir "\")")))
+               (substitute* "swank-loader.lisp"
+                 (("\\(probe-file fasl\\)" all)
+                  ;; Do not try to delete Guix store files.
+                  (string-append
+                   all "\n"
+                   " (not (equal (subseq (pathname-directory fasl) 1 3)"
+                   " '(\"gnu\" \"store\"))) ; XXX: GUIX PATCH")))))))))
     (home-page "https://github.com/slime/slime")
     (synopsis "Common Lisp Swank server")
     (description
@@ -2312,7 +2336,21 @@ (define-public sbcl-slime-swank
     (license (list license:gpl2+ license:public-domain))))
 
 (define-public cl-slime-swank
-  (sbcl-package->cl-source-package sbcl-slime-swank))
+  (let ((pkg (sbcl-package->cl-source-package sbcl-slime-swank)))
+    (package
+      (inherit pkg)
+      (arguments
+       (substitute-keyword-arguments (package-arguments pkg)
+         ((#:phases phases)
+          `(modify-phases ,phases
+             (add-after 'install 'revert-asd-patch
+               ;; We do not want to include the Guix patch in the cl- package
+               ;; since it would include the sbcl- package in the closure.
+               (lambda* (#:key outputs #:allow-other-keys)
+                 (let* ((out (assoc-ref outputs "out"))
+                        (source-path (string-append out "/share/common-lisp/source/")))
+                   (substitute* (string-append source-path "/cl-slime-swank/swank.asd")
+                     ((".*fasl-directory.*") ""))))))))))))
 
 (define-public ecl-slime-swank
   (sbcl-package->ecl-package sbcl-slime-swank))