diff --git a/pcl/env.lisp b/pcl/env.lisp index b3d1b595257cc6d57d80390b2818f6c4f4b678dc..c1f325d9de9035c1321eb1fd308c7495942b49ae 100644 --- a/pcl/env.lisp +++ b/pcl/env.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/env.lisp,v 1.13 2001/03/14 23:25:16 pw Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/env.lisp,v 1.14 2002/06/05 23:00:11 pmai Exp $") ;;; ;;; Basic environmental stuff. ;;; @@ -329,8 +329,8 @@ (defmethod make-instance ((class lisp:class) &rest stuff) (apply #'make-instance (coerce-to-pcl-class class) stuff)) -(defmethod change-class (instance (class lisp:class)) - (apply #'change-class instance (coerce-to-pcl-class class))) +(defmethod change-class (instance (class lisp:class) &rest initargs) + (apply #'change-class instance (coerce-to-pcl-class class) initargs)) (macrolet ((frob (&rest names) `(progn diff --git a/pcl/generic-functions.lisp b/pcl/generic-functions.lisp index 6c2d36f4fc8fb020ef971f0df6c2c3e5e407bbb0..3cfc7fe12a80d0a2afb2e4d6366c6c125e130274 100644 --- a/pcl/generic-functions.lisp +++ b/pcl/generic-functions.lisp @@ -2,7 +2,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/generic-functions.lisp,v 1.9 1999/05/30 23:14:00 pw Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/generic-functions.lisp,v 1.10 2002/06/05 23:00:11 pmai Exp $") ;;; (in-package :pcl) @@ -489,7 +489,7 @@ (defgeneric add-method (generic-function method)) ; (standard-generic-function method) -(defgeneric change-class (instance new-class-name)) +(defgeneric change-class (instance new-class-name &rest initargs)) ; (standard-object standard-class) ; (funcallable-standard-object funcallable-standard-class) ; (t symbol) diff --git a/pcl/std-class.lisp b/pcl/std-class.lisp index 170e0900d6f17ecef60eaaee31cb5d89fa0e26c5..1fd787d8b8f8b3082f36833bdd066be856f489c0 100644 --- a/pcl/std-class.lisp +++ b/pcl/std-class.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.28 2001/11/29 03:50:35 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.29 2002/06/05 23:00:12 pmai Exp $") ;;; (in-package :pcl) @@ -1198,7 +1198,7 @@ (setf (fsc-instance-slots ,instance) (fsc-instance-slots ,instance))) copy))) -(defun change-class-internal (instance new-class) +(defun change-class-internal (instance new-class initargs) (let* ((old-class (class-of instance)) (copy (allocate-instance new-class)) (new-wrapper (get-wrapper copy)) @@ -1234,31 +1234,37 @@ ;; old instance point to the new storage. (swap-wrappers-and-slots instance copy) - (update-instance-for-different-class copy instance) + (apply #'update-instance-for-different-class copy instance initargs) instance)) (defmethod change-class ((instance standard-object) - (new-class standard-class)) - (change-class-internal instance new-class)) + (new-class standard-class) + &rest initargs) + (change-class-internal instance new-class initargs)) (defmethod change-class ((instance funcallable-standard-object) - (new-class funcallable-standard-class)) - (change-class-internal instance new-class)) + (new-class funcallable-standard-class) + &rest initargs) + (change-class-internal instance new-class initargs)) (defmethod change-class ((instance standard-object) - (new-class funcallable-standard-class)) + (new-class funcallable-standard-class) + &rest initargs) + (declare (ignore initargs)) (error "Can't change the class of ~S to ~S~@ because it isn't already an instance with metaclass ~S." instance new-class 'standard-class)) (defmethod change-class ((instance funcallable-standard-object) - (new-class standard-class)) + (new-class standard-class) + &rest initargs) + (declare (ignore initargs)) (error "Can't change the class of ~S to ~S~@ because it isn't already an instance with metaclass ~S." instance new-class 'funcallable-standard-class)) -(defmethod change-class ((instance t) (new-class-name symbol)) - (change-class instance (find-class new-class-name))) +(defmethod change-class ((instance t) (new-class-name symbol) &rest initargs) + (apply #'change-class instance (find-class new-class-name) initargs))