From: Christophe R. <cr...@us...> - 2003-03-29 15:14:34
|
Update of /cvsroot/sbcl/sbcl/src/pcl In directory sc8-pr-cvs1:/tmp/cvs-serv17653/src/pcl Modified Files: braid.lisp generic-functions.lisp std-class.lisp Log Message: 0.pre8.13: Make ENSURE-CLASS-USING-CLASS's arguments go the AMOP-specified way round (noted sbcl-devel 2003-29-03 by CSR) Index: braid.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/pcl/braid.lisp,v retrieving revision 1.30 retrieving revision 1.31 diff -u -d -r1.30 -r1.31 --- braid.lisp 24 Mar 2003 18:39:08 -0000 1.30 +++ braid.lisp 29 Mar 2003 15:14:29 -0000 1.31 @@ -543,11 +543,11 @@ (mapcar #'classoid-name (classoid-direct-superclasses (find-classoid name))))) (if slotsp - (ensure-class-using-class name nil + (ensure-class-using-class nil name :metaclass metaclass :name name :direct-superclasses supers :direct-slots slots) - (ensure-class-using-class name nil + (ensure-class-using-class nil name :metaclass metaclass :name name :direct-superclasses supers))))) (cond ((structure-type-p name) Index: generic-functions.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/pcl/generic-functions.lisp,v retrieving revision 1.16 retrieving revision 1.17 diff -u -d -r1.16 -r1.17 --- generic-functions.lisp 23 Dec 2002 13:53:00 -0000 1.16 +++ generic-functions.lisp 29 Mar 2003 15:14:30 -0000 1.17 @@ -476,8 +476,8 @@ (defgeneric allocate-instance (class &rest initargs)) -(defgeneric ensure-class-using-class (name - class +(defgeneric ensure-class-using-class (class + name &rest args &key &allow-other-keys)) Index: std-class.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/pcl/std-class.lisp,v retrieving revision 1.39 retrieving revision 1.40 diff -u -d -r1.39 -r1.40 --- std-class.lisp 25 Mar 2003 00:13:18 -0000 1.39 +++ std-class.lisp 29 Mar 2003 15:14:30 -0000 1.40 @@ -327,9 +327,9 @@ (setf (gdefinition 'load-defclass) #'real-load-defclass) (defun ensure-class (name &rest all) - (apply #'ensure-class-using-class name (find-class name nil) all)) + (apply #'ensure-class-using-class (find-class name nil) name all)) -(defmethod ensure-class-using-class (name (class null) &rest args &key) +(defmethod ensure-class-using-class ((class null) name &rest args &key) (multiple-value-bind (meta initargs) (ensure-class-values class args) (set-class-type-translation (class-prototype meta) name) @@ -338,7 +338,7 @@ (set-class-type-translation class name) class)) -(defmethod ensure-class-using-class (name (class pcl-class) &rest args &key) +(defmethod ensure-class-using-class ((class pcl-class) name &rest args &key) (multiple-value-bind (meta initargs) (ensure-class-values class args) (unless (eq (class-of class) meta) (change-class class meta)) |