From f8bfa4d8ce6b831058935c793e9d9180a46e4171 Mon Sep 17 00:00:00 2001 From: ajberkley 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 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))))))))