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