Update of /cvsroot/sbcl/sbcl/src/pcl
In directory sc8-pr-cvs1:/tmp/cvs-serv16769/src/pcl
Modified Files:
generic-functions.lisp std-class.lisp
Log Message:
0.8alpha.0.3:
* src/pcl/std-class.lisp, src/pcl/generic-functions.lisp:
Change signature of {direct,effective}-slot-definiton-class
to match AMOP
Index: generic-functions.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/pcl/generic-functions.lisp,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -d -r1.18 -r1.19
--- generic-functions.lisp 17 Apr 2003 15:34:02 -0000 1.18
+++ generic-functions.lisp 30 Apr 2003 19:55:06 -0000 1.19
@@ -332,9 +332,9 @@
(defgeneric describe-object (object stream))
-(defgeneric direct-slot-definition-class (class initargs))
+(defgeneric direct-slot-definition-class (class &rest initargs))
-(defgeneric effective-slot-definition-class (class initargs))
+(defgeneric effective-slot-definition-class (class &rest initargs))
(defgeneric legal-documentation-p (object x))
Index: std-class.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/pcl/std-class.lisp,v
retrieving revision 1.46
retrieving revision 1.47
diff -u -d -r1.46 -r1.47
--- std-class.lisp 28 Apr 2003 11:00:30 -0000 1.46
+++ std-class.lisp 30 Apr 2003 19:55:09 -0000 1.47
@@ -744,7 +744,7 @@
(make-class-predicate class predicate-name)
(add-slot-accessors class direct-slots)))
-(defmethod direct-slot-definition-class ((class structure-class) initargs)
+(defmethod direct-slot-definition-class ((class structure-class) &rest initargs)
(declare (ignore initargs))
(find-class 'structure-direct-slot-definition))
@@ -936,14 +936,14 @@
;;;; protocols for constructing direct and effective slot definitions
-(defmethod direct-slot-definition-class ((class std-class) initargs)
+(defmethod direct-slot-definition-class ((class std-class) &rest initargs)
(declare (ignore initargs))
(find-class 'standard-direct-slot-definition))
(defun make-direct-slotd (class initargs)
(let ((initargs (list* :class class initargs)))
(apply #'make-instance
- (direct-slot-definition-class class initargs)
+ (apply #'direct-slot-definition-class class initargs)
initargs)))
(defmethod compute-slots ((class std-class))
@@ -1050,14 +1050,14 @@
(defmethod compute-effective-slot-definition ((class slot-class) name dslotds)
(declare (ignore name))
(let* ((initargs (compute-effective-slot-definition-initargs class dslotds))
- (class (effective-slot-definition-class class initargs)))
+ (class (apply #'effective-slot-definition-class class initargs)))
(apply #'make-instance class initargs)))
-(defmethod effective-slot-definition-class ((class std-class) initargs)
+(defmethod effective-slot-definition-class ((class std-class) &rest initargs)
(declare (ignore initargs))
(find-class 'standard-effective-slot-definition))
-(defmethod effective-slot-definition-class ((class structure-class) initargs)
+(defmethod effective-slot-definition-class ((class structure-class) &rest initargs)
(declare (ignore initargs))
(find-class 'structure-effective-slot-definition))
|