11/11: gnu: cl-fast-generic-functions: Fix build with sbcl >= 2.4.0.

[guix-commits]

glv pushed a commit to branch lisp-team
in repository guix.

commit 5abf9c0c6b9c3ac41c5203c7aa69d08f47924e04
Author: Guillaume Le Vaillant <glv@posteo.net>
AuthorDate: Thu May 30 18:40:38 2024 +0200

    gnu: cl-fast-generic-functions: Fix build with sbcl >= 2.4.0.
    
    * gnu/packages/patches/sbcl-fast-generic-functions-fix-sbcl-2.4.patch: Add
      file.
    * gnu/local.mk (dist_patch_DATA): Register it.
    * gnu/packages/lisp-xyz.scm (sbcl-fast-generic-functions)[source]: Use it.
    
    Change-Id: Ifcc5b3c5c2d51570303063ca3b01f9c0b5849e88
---
 gnu/local.mk                                       |  1 +
 gnu/packages/lisp-xyz.scm                          |  4 +-
 .../sbcl-fast-generic-functions-fix-sbcl-2.4.patch | 99 ++++++++++++++++++++++
 3 files changed, 103 insertions(+), 1 deletion(-)

diff --git a/gnu/local.mk b/gnu/local.mk
index c386e773ed..58e972e8f8 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -2065,6 +2065,7 @@ dist_patch_DATA =                                         
\
   %D%/packages/patches/sbcl-burgled-batteries3-fix-signals.patch       \
   %D%/packages/patches/sbcl-clml-fix-types.patch               \
   %D%/packages/patches/sbcl-eazy-gnuplot-skip-path-check.patch \
+  %D%/packages/patches/sbcl-fast-generic-functions-fix-sbcl-2.4.patch  \
   %D%/packages/patches/sbcl-png-fix-sbcl-compatibility.patch   \
   %D%/packages/patches/scalapack-gcc-10-compilation.patch      \
   %D%/packages/patches/scheme48-tests.patch                    \
diff --git a/gnu/packages/lisp-xyz.scm b/gnu/packages/lisp-xyz.scm
index cbd23eb200..6006507075 100644
--- a/gnu/packages/lisp-xyz.scm
+++ b/gnu/packages/lisp-xyz.scm
@@ -14701,7 +14701,9 @@ basic everyday functions and macros.")
                (commit commit)))
          (file-name (git-file-name "cl-fast-generic-functions" version))
          (sha256
-          (base32 "16hf9bi2p5s77p3m3aqsihcd9iicqjhhxxpsarjv93c41qs54yad"))))
+          (base32 "16hf9bi2p5s77p3m3aqsihcd9iicqjhhxxpsarjv93c41qs54yad"))
+         (patches
+          (search-patches "sbcl-fast-generic-functions-fix-sbcl-2.4.patch"))))
       (build-system asdf-build-system/sbcl)
       (inputs
        (list sbcl-closer-mop
diff --git 
a/gnu/packages/patches/sbcl-fast-generic-functions-fix-sbcl-2.4.patch 
b/gnu/packages/patches/sbcl-fast-generic-functions-fix-sbcl-2.4.patch
new file mode 100644
index 0000000000..d8b30f24a3
--- /dev/null
+++ b/gnu/packages/patches/sbcl-fast-generic-functions-fix-sbcl-2.4.patch
@@ -0,0 +1,99 @@
+From f8bfa4d8ce6b831058935c793e9d9180a46e4171 Mon Sep 17 00:00:00 2001
+From: ajberkley <ajberkley@gmail.com>
+Date: Mon, 27 May 2024 14:21:22 -0700
+Subject: [PATCH 1/2] Fix to work with SBCL 2.4.0 and later
+
+---
+ code/expand-effective-method-body.lisp | 54 +++++++++++++-------------
+ 1 file changed, 28 insertions(+), 26 deletions(-)
+
+diff --git a/code/expand-effective-method-body.lisp 
b/code/expand-effective-method-body.lisp
+index c00c1b0..68c0b08 100644
+--- a/code/expand-effective-method-body.lisp
++++ b/code/expand-effective-method-body.lisp
+@@ -2,35 +2,37 @@
+ 
+ (defun expand-effective-method-body
+     (effective-method generic-function lambda-list)
+-  (trivial-macroexpand-all:macroexpand-all
+-   `(let ((.gf. #',(generic-function-name generic-function)))
+-      (declare (ignorable .gf.))
+-      #+sbcl(declare (sb-ext:disable-package-locks common-lisp:call-method))
+-      #+sbcl(declare (sb-ext:disable-package-locks common-lisp:make-method))
+-      #+sbcl(declare (sb-ext:disable-package-locks 
sb-pcl::check-applicable-keywords))
+-      #+sbcl(declare (sb-ext:disable-package-locks 
sb-pcl::%no-primary-method))
+-      (macrolet
+-          (;; SBCL introduces explicit keyword argument checking into
+-           ;; the effective method.  Since we do our own checking, we
+-           ;; can safely disable it.  However, we touch the relevant
+-           ;; variables to prevent unused variable warnings.
+-           #+sbcl
+-           (sb-pcl::check-applicable-keywords (&rest args)
+-             (declare (ignore args))
+-             `(progn sb-pcl::.valid-keys. sb-pcl::.keyargs-start. (values)))
+-           ;; SBCL introduces a magic form to report when there are no
+-           ;; primary methods.  The problem is that this form contains a
+-           ;; reference to the literal generic function, which is not an
+-           ;; externalizable object.  Our solution is to replace it with
+-           ;; something portable.
+-           #+sbcl
+-           (sb-pcl::%no-primary-method (&rest args)
+-             (declare (ignore args))
+-             `(apply #'no-primary-method .gf. 
,@',(lambda-list-apply-arguments lambda-list))))
++  (let ((%no-primary-method (find-symbol "%NO-PRIMARY-METHOD" :sb-pcl)))
++    (trivial-macroexpand-all:macroexpand-all
++     `(let ((.gf. #',(generic-function-name generic-function)))
++        (declare (ignorable .gf.))
++        #+sbcl(declare (sb-ext:disable-package-locks common-lisp:call-method))
++        #+sbcl(declare (sb-ext:disable-package-locks common-lisp:make-method))
++        #+sbcl(declare (sb-ext:disable-package-locks 
sb-pcl::check-applicable-keywords))
++        #+sbcl(declare (sb-ext:disable-package-locks ,%no-primary-method))
++        (macrolet
++            (;; SBCL introduces explicit keyword argument checking into
++             ;; the effective method.  Since we do our own checking, we
++             ;; can safely disable it.  However, we touch the relevant
++             ;; variables to prevent unused variable warnings.
++             #+sbcl
++             (sb-pcl::check-applicable-keywords (&rest args)
++               (declare (ignore args))
++               `(progn sb-pcl::.valid-keys. sb-pcl::.keyargs-start. (values)))
++             ;; SBCL introduces a magic form to report when there are no
++             ;; primary methods.  The problem is that this form contains a
++             ;; reference to the literal generic function, which is not an
++             ;; externalizable object.  Our solution is to replace it with
++             ;; something portable.
++             #+sbcl
++             ,(when %no-primary-method
++                `(,%no-primary-method (&rest args)
++                     (declare (ignore args))
++                     `(apply #'no-primary-method .gf. 
,@',(lambda-list-apply-arguments lambda-list)))))
+         ,(wrap-in-call-method-macrolet
+           effective-method
+           generic-function
+-          lambda-list)))))
++          lambda-list))))))
+ 
+ (defun wrap-in-call-method-macrolet (form generic-function lambda-list)
+   `(macrolet ((call-method (method &optional next-methods)
+
+From 01baf2bc9157762029de11ab64429999fa7a58da Mon Sep 17 00:00:00 2001
+From: ajberkley <ajberkley@gmail.com>
+Date: Mon, 27 May 2024 14:37:58 -0700
+Subject: [PATCH 2/2] Fix for SBCL
+
+---
+ code/sbcl.lisp | 2 +-
+ 1 file changed, 1 insertion(+), 1 deletion(-)
+
+diff --git a/code/sbcl.lisp b/code/sbcl.lisp
+index 9e206a8..b97c00a 100644
+--- a/code/sbcl.lisp
++++ b/code/sbcl.lisp
+@@ -13,6 +13,6 @@
+                        (prototypes static-call-signature-prototypes))
+           static-call-signature
+         (eval
+-         `(sb-c:deftransform ,name ((&rest args) (,@types &rest *))
++         `(sb-c:deftransform ,name ((&rest args) (,@types &rest t))
+             (or (optimize-function-call #',name ',static-call-signature)
+                 (sb-c::give-up-ir1-transform))))))))