From 3aaed55326303bb377c4821c5e83b2e4e9c538fc Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Wed, 30 Oct 2002 12:54:47 +0000 Subject: [PATCH] 0.7.9.15: Implement GENERIC-FUNCTION-DECLARATIONS, more-or-less as in Gerd's implementation on cmucl-imp 86fzvadsgr.fsf@gerd.free-bsd.org ... only for STANDARD-GENERIC-FUNCTIONS, but as an :ACCESSOR not a :READER (following the other slots of a S-G-F) --- NEWS | 9 +++++++-- src/pcl/boot.lisp | 2 +- src/pcl/defs.lisp | 4 ++++ src/pcl/generic-functions.lisp | 5 +++++ tests/mop.impure.lisp | 10 ++++++++++ version.lisp-expr | 2 +- 6 files changed, 28 insertions(+), 4 deletions(-) diff --git a/NEWS b/NEWS index 7076991..3abef44 100644 --- a/NEWS +++ b/NEWS @@ -1351,8 +1351,13 @@ changes in sbcl-0.7.9 relative to sbcl-0.7.8: truename. * more systematization and improvement of CLOS and MOP conformance in PCL (thanks to Gerd Moellman and Pierre Mai): - ** NO-NEXT-METHOD is now implemented; - + ** the standard ANSI CL generic function NO-NEXT-METHOD is now + implemented; + ** DEFINE-METHOD-COMBINATION no longer signals an error for + primary methods with no specializers; + ** the MOP generic function GENERIC-FUNCTION-DECLARATIONS is now + implemented; + planned incompatible changes in 0.7.x: * When the profiling interface settles down, maybe in 0.7.x, maybe later, it might impact TRACE. They both encapsulate functions, and diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp index 559b3ea..1ccb0ae 100644 --- a/src/pcl/boot.lisp +++ b/src/pcl/boot.lisp @@ -189,7 +189,7 @@ bootstrapping. :format-control "The declaration specifier ~S ~ is not allowed inside DEFGENERIC." :format-arguments (list (cadr option)))) - (push (cdr option) (initarg :declarations))) + (push (cadr option) (initarg :declarations))) ((:argument-precedence-order :method-combination) (if (initarg car-option) (duplicate-option car-option) diff --git a/src/pcl/defs.lisp b/src/pcl/defs.lisp index ba5ccd4..ebf2eff 100644 --- a/src/pcl/defs.lisp +++ b/src/pcl/defs.lisp @@ -772,6 +772,10 @@ (method-combination :initarg :method-combination :accessor generic-function-method-combination) + (declarations + :initarg :declarations + :initform () + :accessor generic-function-declarations) (arg-info :initform (make-arg-info) :reader gf-arg-info) diff --git a/src/pcl/generic-functions.lisp b/src/pcl/generic-functions.lisp index 7dac4bc..0a2a808 100644 --- a/src/pcl/generic-functions.lisp +++ b/src/pcl/generic-functions.lisp @@ -84,6 +84,8 @@ (defgeneric eql-specializer-object (eql-specializer)) +(defgeneric generic-function-declarations (standard-generic-function)) + (defgeneric generic-function-method-class (standard-generic-function)) (defgeneric generic-function-method-combination (standard-generic-function)) @@ -176,6 +178,9 @@ (defgeneric (setf generic-function-method-combination) (new-value standard-generic-function)) +(defgeneric (setf generic-function-declarations) (new-value + standard-generic-function)) + (defgeneric (setf generic-function-methods) (new-value standard-generic-function)) diff --git a/tests/mop.impure.lisp b/tests/mop.impure.lisp index 9e09e31..84a7e32 100644 --- a/tests/mop.impure.lisp +++ b/tests/mop.impure.lisp @@ -37,6 +37,16 @@ (sb-pcl:generic-function-argument-precedence-order #'documentation) (let ((ll (sb-pcl:generic-function-lambda-list #'documentation))) (list (nth 1 ll) (nth 0 ll))))) + +(assert (null + (sb-pcl:generic-function-declarations #'fn-with-odd-arg-precedence))) +(defgeneric gf-with-declarations (x) + (declare (optimize (speed 3))) + (declare (optimize (safety 0)))) +(let ((decls (sb-pcl:generic-function-declarations #'gf-with-declarations))) + (assert (= (length decls) 2)) + (assert (member '(optimize (speed 3)) decls :test #'equal)) + (assert (member '(optimize (safety 0)) decls :test #'equal))) ;;; Readers for Slot Definition Metaobjects (pp. 221--224 of AMOP) diff --git a/version.lisp-expr b/version.lisp-expr index 3ee10d7..20ec6fd 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.9.14" +"0.7.9.15" -- 1.7.10.4