From 20be6570feeace0e60cd9993eb3668ade3e8edc3 Mon Sep 17 00:00:00 2001 From: Mark Wooding Date: Thu, 18 May 2006 09:41:29 +0100 Subject: [PATCH] mop: Rearrange a bit. Put the miscellaneous stuff before the metaclass hacking. --- mdw-mop.lisp | 46 +++++++++++++++++++++++----------------------- 1 file changed, 23 insertions(+), 23 deletions(-) diff --git a/mdw-mop.lisp b/mdw-mop.lisp index 51db744..160eff9 100644 --- a/mdw-mop.lisp +++ b/mdw-mop.lisp @@ -28,8 +28,8 @@ (defpackage #:mdw.mop (:use #:common-lisp #:mdw.base #+cmu #:mop) - (:export #:compatible-class - #:copy-instance #:copy-instance-using-class + (:export #:copy-instance #:copy-instance-using-class + #:compatible-class #:initargs-for-effective-slot #:make-effective-slot #:filtered-slot-class-mixin #:filtered-direct-slot-definition @@ -43,6 +43,27 @@ (in-package #:mdw.mop) ;;;-------------------------------------------------------------------------- +;;; Copying instances. + +(defgeneric copy-instance-using-class (class object &rest initargs) + (:documentation + "Does the donkey-work behind copy-instance.")) + +(defmethod copy-instance-using-class + ((class standard-class) object &rest initargs) + (let ((new (apply #'allocate-instance class initargs))) + (dolist (slot (class-slots class)) + (setf (slot-value-using-class class new slot) + (slot-value-using-class class object slot))) + (apply #'shared-initialize new nil initargs) + new)) + +(defun copy-instance (object &rest initargs) + "Make a copy of OBJECT, modifying it by setting slots as requested by + INITARGS." + (apply #'copy-instance-using-class (class-of object) object initargs)) + +;;;-------------------------------------------------------------------------- ;;; Basic stuff. (defclass compatible-class (standard-class) @@ -65,27 +86,6 @@ (eq (class-of sub) (find-class 'standard-class))) ;;;-------------------------------------------------------------------------- -;;; Copying instances. - -(defgeneric copy-instance-using-class (class object &rest initargs) - (:documentation - "Does the donkey-work behind copy-instance.")) - -(defmethod copy-instance-using-class - ((class standard-class) object &rest initargs) - (let ((new (apply #'allocate-instance class initargs))) - (dolist (slot (class-slots class)) - (setf (slot-value-using-class class new slot) - (slot-value-using-class class object slot))) - (apply #'shared-initialize new nil initargs) - new)) - -(defun copy-instance (object &rest initargs) - "Make a copy of OBJECT, modifying it by setting slots as requested by - INITARGS." - (apply #'copy-instance-using-class (class-of object) object initargs)) - -;;;-------------------------------------------------------------------------- ;;; Utilities for messing with slot options. (defgeneric initargs-for-effective-slot (class direct-slots) -- 2.11.0