From michaelw+closer at foldr.org Thu Dec 1 10:22:09 2005 From: michaelw+closer at foldr.org (Michael Weber) Date: Thu, 1 Dec 2005 11:22:09 +0100 Subject: [closer-devel] Redefining classes Message-ID: <20051201102209.GA2726@roadkill.foldr.org> Hi, this mailing list was the closest (hah!) I could find to a (still active) MOP discussion list. If my question is off-topic, I'd love to hear where else to go. I seem not to understand some aspects of class redefinition. Suppose the following situation: (defclass foo () (...) (:metaclass foo-metaclass)) (defclass foo-1 (foo) (...) (:metaclass foo-metaclass)) If I redefine FOO later on to add or remove slots, it gets reinitialized, and I have (defmethod shared-initialize :after ((class foo-metaclass) slot-names &rest initargs &key &allow-other-keys) ...) which recalculates some slot-based information for FOO then. However, FOO-1 is left unchanged, which surprised me a little. I would have expected that it gets reinitialized as well, thus giving the above initializer a chance to recalculate information for FOO-1, too. I am using CLASS-SLOTS in the FOO-METACLASS specific initialization to get to the slots of FOO-1, but that includes inherited slots from FOO as well. Clearly, after redefinition of FOO, that information might be out of date for FOO-1. Is there a way to invalidate and reinitialize all subclasses? I would assume that that's a common issue. Or, if not, is there a (predefined) way to get only those effective slots of a class which are not inherited? I could use CLASS-DIRECT-SLOTS, but that seems wrong, as I am supposed to work with effective slots, no? Cheers, Michael From pc at p-cos.net Thu Dec 1 16:21:46 2005 From: pc at p-cos.net (Pascal Costanza) Date: Thu, 1 Dec 2005 17:21:46 +0100 Subject: [closer-devel] Redefining classes In-Reply-To: <20051201102209.GA2726@roadkill.foldr.org> References: <20051201102209.GA2726@roadkill.foldr.org> Message-ID: Hi Michael, On 1 Dec 2005, at 11:22, Michael Weber wrote: > Hi, > > this mailing list was the closest (hah!) I could find to a (still > active) MOP discussion list. If my question is off-topic, I'd love > to hear where else to go. The newsgroup comp.lang.lisp would also be appropriate, although your question is certainly on-topic here as well. After all, it's a question whose answer will clarify how to interpret the CLOS MOP specification. > I seem not to understand some aspects of class redefinition. Suppose > the following situation: > > (defclass foo () > (...) > (:metaclass foo-metaclass)) > > (defclass foo-1 (foo) > (...) > (:metaclass foo-metaclass)) > > If I redefine FOO later on to add or remove slots, it gets > reinitialized, and I have > > (defmethod shared-initialize :after ((class foo-metaclass) slot-names > &rest initargs > &key &allow-other-keys) > ...) > > which recalculates some slot-based information for FOO then. > > However, FOO-1 is left unchanged, which surprised me a little. I > would have expected that it gets reinitialized as well, thus giving > the above initializer a chance to recalculate information for FOO-1, > too. > > I am using CLASS-SLOTS in the FOO-METACLASS specific initialization to > get to the slots of FOO-1, but that includes inherited slots from FOO > as well. Clearly, after redefinition of FOO, that information might > be out of date for FOO-1. I don't think it will be out of date for FOO-1. CLASS-SLOTS gives you the set of effective slots, that is, all slots that are accessible in a class. The class initialization/reinitialization phase is, among other things, responsible for determining the direct slots - the ones that directly defined for a given class, without the inherited slots - but _not_ for determining the effective slots. The effective slots are determined by the class finalization protocol, that is, by the generic function finalize-inheritance. So when you reinitialize a class, it's not reinitialize-instance that is being called for all subclasses, but finalize-inheritance. At least that is what should happen. Note that it is not specified when this happens. According to the class redefinition specification in ANSI Common Lisp, it is strictly only necessary before the first instance of a given subclass is accessed, so just before update-instance-for-redefined-class is first called - see Section 4.3.6 in the HyperSpec. I don't know whether any CLOS implementation takes advantage of that freedom. (It seems to me that only Allegro Common Lisp takes the freedom to delay calling finalize-inheritance after initializing a class in the first place, so I would guess that this would also only happen in Allegro if at all. But that's only a guess.) > Is there a way to invalidate and reinitialize all subclasses? I would > assume that that's a common issue. I don't think there's a need to do that. Or do you have evidence that something's going wrong here? If so, could you be more specific - including which Common Lisp implementation you use? > Or, if not, is there a (predefined) way to get only those effective > slots of a class which are not inherited? I could use > CLASS-DIRECT-SLOTS, but that seems wrong, as I am supposed to work > with effective slots, no? I don't understand that question. The direct slots are exactly the slots defined for a given class - without the inherited slots - so if they are what you're interested in you should be fine. Maybe it's a good idea to tell us your overall goal - what is it that you are actually trying to achieve? Cheers, Pascal -- Pascal Costanza, mailto:pc at p-cos.net, http://p-cos.net Vrije Universiteit Brussel, Programming Technology Lab Pleinlaan 2, B-1050 Brussel, Belgium From michaelw+closer at foldr.org Thu Dec 1 19:27:43 2005 From: michaelw+closer at foldr.org (Michael Weber) Date: Thu, 1 Dec 2005 20:27:43 +0100 Subject: [closer-devel] Redefining classes In-Reply-To: References: <20051201102209.GA2726@roadkill.foldr.org> Message-ID: <20051201192743.GC2726@roadkill.foldr.org> * Pascal Costanza [2005-12-01T17:21+0100]: > On 1 Dec 2005, at 11:22, Michael Weber wrote: [...] Thanks for the quick answer, Pascal. I am trying to wrap my head around this now. I might sound a little confusing, as I am not yet using the right terminology in all cases. I'll try to fix that. :) > >Is there a way to invalidate and reinitialize all subclasses? I would > >assume that that's a common issue. > > I don't think there's a need to do that. Or do you have evidence that > something's going wrong here? If so, could you be more specific - > including which Common Lisp implementation you use? CL-USER> (list (lisp-implementation-type) (lisp-implementation-version)) ("SBCL" "0.8.16") It's old, I know. Various reason hold me off to upgrade it. If there have been relevant bug fixes affecting the code below, I'll apologize for wasting everybody's time. I'd have to suspend this experiment then until I can upgrade. > Maybe it's a good idea to tell us your overall goal - what is it that > you are actually trying to achieve? Automatically generating equality methods for objects (EQL-OBJECTS, with EQUALS being the user interface). Code attached. It's quite rough around the edges, as I am just writing this. Notice that I am generating code for all (CLASS-SLOTS class), which returns a list of effective slot definition objects. My test code looks like this: (define-eql-class bar () ((slot-1 :reader slot-1 :initarg :slot-1 :equality equals) (slot-2 :reader slot-2 :initarg :slot-2))) (define-eql-class bar-1 (bar) ((slot-3 :initarg :slot-3 :equality equal))) I tried to attach my method generation code to FINALIZE-INHERITANCE first: ;;;; (define-eql-class bar-1 (bar) ((slot-3 :initarg :slot-3 ... 0: (FINALIZE-INHERITANCE #) 0: FINALIZE-INHERITANCE returned NIL ;;;; (define-eql-class bar-1 (bar) ((slot-3 :initarg :slot-3 ... CL-USER> (make-instance 'bar-1) # CL-USER> With my SBCL, FINALIZE-INHERITANCE seems to be called the first time a class is defined, but _not_ if it is redefined. I think that's contrary to what AMOP says should happen. (Issue #1) To be able to proceed, I worked around it by instead using an :after method on SHARED-INITIALIZE for my metaclass, which is called everytime I redefine a class (I traced it): ;;;; (define-eql-class bar () ((slot-1 :reader slot-1 ... (SHARED-INITIALIZE #) ;;;; (define-eql-class bar () ((slot-1 :reader slot-1 ... (SHARED-INITIALIZE #) The real problem comes up if I redefine class BAR (removing slots), without redefining its subclasses, namely BAR-1: CL-USER> (define-eql-class bar () ((slot-1 :reader slot-1 :initarg :slot-1 :equality equals))) # Let's check that EQUAL-OBJECTS method for BAR was updated wrt. to the now removed slot: CL-USER> (equals #1=(make-instance 'bar) #1#) (FROM-CLASS (AND (IF (SLOT-BOUNDP X 'SLOT-1) (AND (SLOT-BOUNDP Y 'SLOT-1) (FUNCALL #'EQUALS (SLOT-VALUE X 'SLOT-1) (SLOT-VALUE Y 'SLOT-1))) (NOT (SLOT-BOUNDP Y 'SLOT-1))))) T CL-USER> Indeed, it is updated (no mention of SLOT-2). Now let's check with BAR-1: CL-USER> (equals #1=(make-instance 'bar-1) #1#) (FROM-CLASS (AND (IF (SLOT-BOUNDP X 'SLOT-3) (AND (SLOT-BOUNDP Y 'SLOT-3) (FUNCALL #'EQUAL (SLOT-VALUE X 'SLOT-3) (SLOT-VALUE Y 'SLOT-3))) (NOT (SLOT-BOUNDP Y 'SLOT-3))) (IF (SLOT-BOUNDP X 'SLOT-1) (AND (SLOT-BOUNDP Y 'SLOT-1) (FUNCALL #'EQUALS (SLOT-VALUE X 'SLOT-1) (SLOT-VALUE Y 'SLOT-1))) (NOT (SLOT-BOUNDP Y 'SLOT-1))) (IF (SLOT-BOUNDP X 'SLOT-2) (AND (SLOT-BOUNDP Y 'SLOT-2) (FUNCALL #'EQL (SLOT-VALUE X 'SLOT-2) (SLOT-VALUE Y 'SLOT-2))) (NOT (SLOT-BOUNDP Y 'SLOT-2))))) I get the following condition: When attempting to test to see whether slot is bound (SLOT-BOUNDP), the slot SLOT-2 is missing from the object #. [Condition of type SIMPLE-ERROR] That's not very surprising, if the EQUAL-OBJECTS method for BAR-1 was not updated, and thus still contains code to access SLOT-2 (of BAR). However, it is surprising to me that there seems to be no protocol available to reinitialize subclasses if a class changes (Issue #2), so that EQL-OBJECTS for BAR-1 would be regenerated with up-to-date information about class slots of its superclasses. Then again, maybe I really should be using CLASS-DIRECT-SLOTS and generate methods somewhat like this: (let* (... ;;; use only the effective slots objects corresponding ;;; to direct slots (direct-effective-slots (intersection (class-slots class) (class-direct-slots class) :key #'slot-definition-name)) (comparison-code `(AND ,@(loop for slot in direct-effective-slots for s-d-name = (slot-definition-name slot) for equality = (eql-effective-slot-definition-equality slot) collect `(IF (SLOT-BOUNDP X ',s-d-name) (AND (SLOT-BOUNDP Y ',s-d-name) (FUNCALL (FUNCTION ,equality) (SLOT-VALUE X ',s-d-name) (SLOT-VALUE Y ',s-d-name))) (NOT (SLOT-BOUNDP Y ',s-d-name)))) ;;; defer work to previously generated instances (CALL-NEXT-METHOD)))) ...) Calls look like this then: CL-USER> (equals #1=(make-instance 'bar-1) #1#) (FROM-CLASS (AND (IF (SLOT-BOUNDP X 'SLOT-3) (AND (SLOT-BOUNDP Y 'SLOT-3) (FUNCALL #'EQUAL (SLOT-VALUE X 'SLOT-3) (SLOT-VALUE Y 'SLOT-3))) (NOT (SLOT-BOUNDP Y 'SLOT-3))) (CALL-NEXT-METHOD))) (FROM-CLASS (AND (IF (SLOT-BOUNDP X 'SLOT-1) (AND (SLOT-BOUNDP Y 'SLOT-1) (FUNCALL #'EQUALS (SLOT-VALUE X 'SLOT-1) (SLOT-VALUE Y 'SLOT-1))) (NOT (SLOT-BOUNDP Y 'SLOT-1))) (IF (SLOT-BOUNDP X 'SLOT-2) (AND (SLOT-BOUNDP Y 'SLOT-2) (FUNCALL #'EQL (SLOT-VALUE X 'SLOT-2) (SLOT-VALUE Y 'SLOT-2))) (NOT (SLOT-BOUNDP Y 'SLOT-2))) (CALL-NEXT-METHOD))) (BASE-CASE T) T CL-USER> That works, but I am not too happy about it for various reasons. Also, I did not think through what happens in the case of more funky inheritance relationships. So, that still leaves me with Issues #1 and #2, which both might as well be figments of my imagination, and I am doing things simply the wrong way. :) Cheers, Michael -------------- next part -------------- (use-package #+sbcl :sb-pcl) ;XXX (defclass eql-class (standard-class) ()) (defclass eql-direct-slot-definition (standard-direct-slot-definition) ((equality :initarg :equality :reader eql-direct-slot-definition-equality))) (defclass eql-effective-slot-definition (standard-effective-slot-definition) ((equality :initarg :indices :initform 'eql :accessor eql-effective-slot-definition-equality))) (defgeneric EQL-OBJECTS (type x y) (:documentation "Equality on objects X and Y modulo type TYPE.") (:method (type x y) (print `(AND (TYPEP X TYPE) (TYPEP Y TYPE) ;XXX (EQL X Y))) (and (typep x type) (typep y type) (eql x y)))) (defun equals (x y &optional (type t)) (EQL-OBJECTS type x y)) (defun %simple-add-method (gf &key lambda-list specializers method-body qualifiers) (let* ((method-class (generic-function-method-class gf))) (multiple-value-bind (method-lambda initargs) (make-method-lambda gf (class-prototype method-class) method-body nil) (add-method gf (apply #'make-instance method-class :function (compile nil method-lambda) :specializers specializers :qualifiers qualifiers :lambda-list lambda-list initargs))))) ;; (defmethod finalize-inheritance :after ((class eql-class)) (defmethod shared-initialize :after ((class eql-class) slot-names &rest initargs &key &allow-other-keys) (declare (ignore slot-names initargs)) (print (list 'shared-initialize class)) (let* ((gf (ensure-generic-function 'EQL-OBJECTS)) (slots (class-slots class)) (lambda-list '(TYPE X Y)) (comparison-code `(AND ,@(loop for slot in (reverse slots) for s-d-name = (slot-definition-name slot) for equality = (eql-effective-slot-definition-equality slot) collect `(IF (SLOT-BOUNDP X ',s-d-name) (AND (SLOT-BOUNDP Y ',s-d-name) (FUNCALL (FUNCTION ,equality) (SLOT-VALUE X ',s-d-name) (SLOT-VALUE Y ',s-d-name))) (NOT (SLOT-BOUNDP Y ',s-d-name))))))) (%simple-add-method gf :lambda-list lambda-list :specializers (list (intern-eql-specializer t) class class) :method-body `(LAMBDA ,lambda-list (print ',(list 'from-class comparison-code)) ;XXX (OR (EQ X Y) (AND (EQ (CLASS-OF X) (CLASS-OF Y)) ,comparison-code)))) (%simple-add-method gf :lambda-list lambda-list :specializers (list (intern-eql-specializer (class-name class)) (find-class t) (find-class t)) :method-body `(LAMBDA ,lambda-list (print ',(list 'from-type comparison-code)) ;XXX (OR (EQ X Y) (AND (TYPEP X TYPE) (TYPEP Y TYPE) ,comparison-code)))))) (defmethod validate-superclass ((class eql-class) (superclass standard-class)) t) ;;XXX what if a STANDARD-CLASS class inherits from an EQL-CLASS class? (defmethod direct-slot-definition-class ((class eql-class) &key (equality nil equality-supplied-p) &allow-other-keys) (declare (ignore equality)) (if equality-supplied-p (find-class 'eql-direct-slot-definition) (call-next-method))) (defmethod effective-slot-definition-class ((class eql-class) &rest initargs) (declare (ignore initargs)) (find-class 'eql-effective-slot-definition)) (defmethod compute-effective-slot-definition ((class eql-class) name direct-slots) (declare (ignore name)) (let* ((normal-slot (call-next-method)) (equality-slots (remove-if (lambda (slot) (not (typep slot 'eql-direct-slot-definition))) direct-slots)) (direct-equality-slot (first equality-slots))) ;XXX slot inheritance? (prog1 normal-slot (unless (null direct-equality-slot) (setf (eql-effective-slot-definition-equality normal-slot) (eql-direct-slot-definition-equality direct-equality-slot)))))) ;XXX COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS? (defmacro define-eql-class (name superclasses slots &rest options) (when (assoc :metaclass options) (error "metaclass option not allowed on eql-class")) `(defclass ,name ,superclasses ,slots , at options (:metaclass eql-class))) From pc at p-cos.net Thu Dec 1 20:43:55 2005 From: pc at p-cos.net (Pascal Costanza) Date: Thu, 1 Dec 2005 21:43:55 +0100 Subject: [closer-devel] Redefining classes In-Reply-To: <20051201192743.GC2726@roadkill.foldr.org> References: <20051201102209.GA2726@roadkill.foldr.org> <20051201192743.GC2726@roadkill.foldr.org> Message-ID: Hi Michael, On 1 Dec 2005, at 20:27, Michael Weber wrote: > * Pascal Costanza [2005-12-01T17:21+0100]: >> On 1 Dec 2005, at 11:22, Michael Weber wrote: > [...] > > Thanks for the quick answer, Pascal. I am trying to wrap my head > around this now. I might sound a little confusing, as I am not yet > using the right terminology in all cases. I'll try to fix that. :) No problem. ;) >>> Is there a way to invalidate and reinitialize all subclasses? I >>> would >>> assume that that's a common issue. >> >> I don't think there's a need to do that. Or do you have evidence that >> something's going wrong here? If so, could you be more specific - >> including which Common Lisp implementation you use? > > CL-USER> (list (lisp-implementation-type) (lisp-implementation- > version)) > ("SBCL" "0.8.16") > > It's old, I know. Various reason hold me off to upgrade it. If there > have been relevant bug fixes affecting the code below, I'll apologize > for wasting everybody's time. I'd have to suspend this experiment > then until I can upgrade. I have no idea what has changed since 0.8.16 since I have started to support SBCL only later (I think). So we have to improvise here... ;) It may help if you could try out also other CL implementations that are more up to date, for example current versions of clisp. (I mention this one because it seems quite portable.) >> Maybe it's a good idea to tell us your overall goal - what is it that >> you are actually trying to achieve? > > Automatically generating equality methods for objects (EQL-OBJECTS, > with EQUALS being the user interface). Code attached. It's quite > rough around the edges, as I am just writing this. Notice that I am > generating code for all (CLASS-SLOTS class), which returns a list of > effective slot definition objects. > > My test code looks like this: > (define-eql-class bar () > ((slot-1 :reader slot-1 > :initarg :slot-1 > :equality equals) > (slot-2 :reader slot-2 > :initarg :slot-2))) > > (define-eql-class bar-1 (bar) > ((slot-3 :initarg :slot-3 > :equality equal))) > > I tried to attach my method generation code to FINALIZE-INHERITANCE > first: > > ;;;; (define-eql-class bar-1 (bar) ((slot-3 :initarg :slot-3 ... > 0: (FINALIZE-INHERITANCE #) > 0: FINALIZE-INHERITANCE returned NIL > ;;;; (define-eql-class bar-1 (bar) ((slot-3 :initarg :slot-3 ... > > CL-USER> (make-instance 'bar-1) > # > CL-USER> > > With my SBCL, FINALIZE-INHERITANCE seems to be called the first time a > class is defined, but _not_ if it is redefined. I think that's > contrary to what AMOP says should happen. (Issue #1) That's true. I don't test for this in MOP Feature Tests, so it is probably a good idea to add a test case. I will add this to my todo list. However, it's a good idea to check what the CLOS MOP already does and whether you can imitate it. This results in behavior that is compliant with what CLOS users are already used to. A similar thing that already happens in CLOS is the automatic generation of reader/ writer/accessor methods, and the CLOS MOP specifies that they are generated during class re/initialization. So it's a good idea to simulate this. > To be able to proceed, I worked around it by instead using an :after > method on SHARED-INITIALIZE for my metaclass, which is called > everytime I redefine a class (I traced it): > > ;;;; (define-eql-class bar () ((slot-1 :reader slot-1 ... > (SHARED-INITIALIZE #) > ;;;; (define-eql-class bar () ((slot-1 :reader slot-1 ... > (SHARED-INITIALIZE #) The CLOS MOP specification specifies that you are not allowed to define methods on shared-initialize for metaobject classes. (Maybe this screws things up?) You are only allowed to define :before, :after or :around methods on initialize-instance and reinitialize-instance (but no primary methods!). So it's probably a good idea to do this in :after methods on initialize-instance and reinitialize-instance. Furthermore note that the automatically generated accessor methods don't need to know anything about effective methods - they are indeed generated only for the direct slots. So the code should roughly look like this: (defmethod initialize-instance :after ((class eql-class) &rest initargs) (declare (ignore initargs)) (loop for slot in (class-direct-slots class) do (generate-method slot class))) Note that you should ensure that old methods are removed on class reinitialization: (defmethod reinitialize-instance :around ((class eql-class) &rest initargs &key (direct-slots nil direct-slots-p)) (declare (ignore initargs)) (if direct-slots-p (progn (loop for meth in previously-generated-methods do (remove-method (method-generci-function meth) meth)) (call-next-method) (loop for slot in (class-direct-slots class) do (generate-method slot class))) (call-next-method))) You should test for direct-slots-p because if it is false the methods don't need to change either. > The real problem comes up if I redefine class BAR (removing slots), > without redefining its subclasses, namely BAR-1: > > CL-USER> (define-eql-class bar () > ((slot-1 :reader slot-1 > :initarg :slot-1 > :equality equals))) > > # > > Let's check that EQUAL-OBJECTS method for BAR was updated wrt. to the > now removed slot: > > CL-USER> (equals #1=(make-instance 'bar) #1#) > (FROM-CLASS > (AND > (IF (SLOT-BOUNDP X 'SLOT-1) > (AND (SLOT-BOUNDP Y 'SLOT-1) > (FUNCALL #'EQUALS (SLOT-VALUE X 'SLOT-1) (SLOT-VALUE Y 'SLOT-1))) > (NOT (SLOT-BOUNDP Y 'SLOT-1))))) > T > CL-USER> > > Indeed, it is updated (no mention of SLOT-2). Now let's check with > BAR-1: > > CL-USER> (equals #1=(make-instance 'bar-1) #1#) > > (FROM-CLASS > (AND > (IF (SLOT-BOUNDP X 'SLOT-3) > (AND (SLOT-BOUNDP Y 'SLOT-3) > (FUNCALL #'EQUAL (SLOT-VALUE X 'SLOT-3) (SLOT-VALUE Y 'SLOT-3))) > (NOT (SLOT-BOUNDP Y 'SLOT-3))) > (IF (SLOT-BOUNDP X 'SLOT-1) > (AND (SLOT-BOUNDP Y 'SLOT-1) > (FUNCALL #'EQUALS (SLOT-VALUE X 'SLOT-1) (SLOT-VALUE Y 'SLOT-1))) > (NOT (SLOT-BOUNDP Y 'SLOT-1))) > (IF (SLOT-BOUNDP X 'SLOT-2) > (AND (SLOT-BOUNDP Y 'SLOT-2) > (FUNCALL #'EQL (SLOT-VALUE X 'SLOT-2) (SLOT-VALUE Y 'SLOT-2))) > (NOT (SLOT-BOUNDP Y 'SLOT-2))))) > > I get the following condition: > > When attempting to test to see whether slot is bound (SLOT- > BOUNDP), the slot > SLOT-2 is missing from the object #. > [Condition of type SIMPLE-ERROR] > > That's not very surprising, if the EQUAL-OBJECTS method for BAR-1 was > not updated, and thus still contains code to access SLOT-2 (of BAR). > > However, it is surprising to me that there seems to be no protocol > available to reinitialize subclasses if a class changes (Issue #2), so > that EQL-OBJECTS for BAR-1 would be regenerated with up-to-date > information about class slots of its superclasses. Again, the subclasses are not reinitialized because there is no reinitialization going on in the first place. The re/initialization phases for class metaobjects are only there to record / process the information that is directly associated with a class definition, without taking into account anything that is inherited from superclasses. Only the class finalization phase combines information from superclasses with those from the class being processed. I still find it hard to believe that this doesn't happen. If you really (really ;) need it, you can work around it by doing this: (defmethod reinitialize-instance :after ((class eql-class) &rest initargs) (declare (ignore initargs)) (loop for subclass in (class-direct-subclasses class) when (class-finalized-p subclass) ; only finalize what was already finalized do (finalize-inheritance subclass))) ...and probably also this... (defmethod finalize-inheritance :after ((class eql-class)) (loop for subclass in (class-direct-subclasses class) when (class-finalized-p subclass) do (finalize-inheritance subclass)) Hmm, there's probably too much finalization going on here... > Then again, maybe I really should be using CLASS-DIRECT-SLOTS and > generate methods somewhat like this: > (let* (... > ;;; use only the effective slots objects corresponding > ;;; to direct slots > (direct-effective-slots (intersection (class-slots > class) > (class-direct- > slots class) > :key #'slot- > definition-name)) > (comparison-code > `(AND ,@(loop for slot in direct-effective-slots > for s-d-name = (slot-definition-name slot) > for equality = (eql-effective-slot-definition-equality slot) > collect `(IF (SLOT-BOUNDP X ',s-d-name) > (AND (SLOT-BOUNDP Y ',s-d-name) > (FUNCALL (FUNCTION ,equality) > (SLOT-VALUE X ',s-d-name) > (SLOT-VALUE Y ',s-d-name))) > (NOT (SLOT-BOUNDP Y ',s-d-name)))) > ;;; defer work to previously generated instances > (CALL-NEXT-METHOD)))) > ...) It's not a good idea to access class-slots in initialize-instance because that information is not yet available at that stage. > Calls look like this then: > > CL-USER> (equals #1=(make-instance 'bar-1) #1#) > (FROM-CLASS > (AND > (IF (SLOT-BOUNDP X 'SLOT-3) > (AND (SLOT-BOUNDP Y 'SLOT-3) > (FUNCALL #'EQUAL (SLOT-VALUE X 'SLOT-3) (SLOT-VALUE Y 'SLOT-3))) > (NOT (SLOT-BOUNDP Y 'SLOT-3))) > (CALL-NEXT-METHOD))) > (FROM-CLASS > (AND > (IF (SLOT-BOUNDP X 'SLOT-1) > (AND (SLOT-BOUNDP Y 'SLOT-1) > (FUNCALL #'EQUALS (SLOT-VALUE X 'SLOT-1) (SLOT-VALUE Y 'SLOT-1))) > (NOT (SLOT-BOUNDP Y 'SLOT-1))) > (IF (SLOT-BOUNDP X 'SLOT-2) > (AND (SLOT-BOUNDP Y 'SLOT-2) > (FUNCALL #'EQL (SLOT-VALUE X 'SLOT-2) (SLOT-VALUE Y 'SLOT-2))) > (NOT (SLOT-BOUNDP Y 'SLOT-2))) > (CALL-NEXT-METHOD))) > (BASE-CASE T) > T > CL-USER> > > That works, but I am not too happy about it for various reasons. > Also, I did not think through what happens in the case of more funky > inheritance relationships. You have to think about inheritance anyway. What if a class specifies a certain equivalence semantics for a given slots, but a subclass specifies a different one for that same slot (i.e., you have two different specification for the same slot name in those two classes). However, since you are generating methods, I would suppose that method inheritance / overriding should automagically take care of this. > So, that still leaves me with Issues #1 and #2, which both might as > well be figments of my imagination, and I am doing things simply the > wrong way. :) I have only superficially browsed through your code, so maybe my comments don't make sense. Nevertheless, I'd be interested to hear whether my hints have helped you in any way or not. Good luck. ;) Pascal -- Pascal Costanza, mailto:pc at p-cos.net, http://p-cos.net Vrije Universiteit Brussel, Programming Technology Lab Pleinlaan 2, B-1050 Brussel, Belgium From pc at p-cos.net Thu Dec 1 21:07:43 2005 From: pc at p-cos.net (Pascal Costanza) Date: Thu, 1 Dec 2005 22:07:43 +0100 Subject: [closer-devel] Redefining classes In-Reply-To: <20051201192743.GC2726@roadkill.foldr.org> References: <20051201102209.GA2726@roadkill.foldr.org> <20051201192743.GC2726@roadkill.foldr.org> Message-ID: <9F319127-747D-49F0-BC65-A7168D9F01CA@p-cos.net> On 1 Dec 2005, at 20:27, Michael Weber wrote: > However, it is surprising to me that there seems to be no protocol > available to reinitialize subclasses if a class changes (Issue #2), so > that EQL-OBJECTS for BAR-1 would be regenerated with up-to-date > information about class slots of its superclasses. I have checked the MOP specification, and indeed it seems to be lacking in this regard. There should be a specification about when finalize-inheritance is called again, whether an implementation can choose to delay re-finalization, what class-finalized-p should indicate, and so on, but this is all missing (unless I am seriously missing something important). But here is another idea: if your methods should depend on the effective rather than the direct slots, you could as well generate them in an :after method on compute-effective-slot-definition. That one should be called when the direct slot definitions of superclasses change... I hope this helps... Pascal -- Pascal Costanza, mailto:pc at p-cos.net, http://p-cos.net Vrije Universiteit Brussel, Programming Technology Lab Pleinlaan 2, B-1050 Brussel, Belgium From joesb.coe9 at gmail.com Tue Dec 20 09:18:42 2005 From: joesb.coe9 at gmail.com (JoeSB COE9) Date: Tue, 20 Dec 2005 09:18:42 +0000 Subject: [closer-devel] ContextL: Class not intialize Message-ID: Hi, I tried to follow ContextL overview document and got stuck. Here is a part of example that got the error. ;;---------- ctx2.lisp (defpackage :ctx2 (:use :contextl)) (in-package :ctx2) (define-layered-class person () ((name :initarg :name :accessor person-name))) (deflayer employment-layer) (define-layered-class person :in-layer employment-layer () ((employer :initarg :employer :layered-accessor person-employer))) ;;---------- END ctx2.lisp And the REPL session goes like this CL-USER> (compile-file "ctx2.lisp") ;; Compiling file D:\dev\code\lisp-systems\joe\ctx2.lisp ... ;; Wrote file D:\dev\code\lisp-systems\joe\ctx2.fas 0 errors, 0 warnings #P"D:\\dev\\code\\lisp-systems\\joe\\ctx2.fas" NIL NIL CL-USER> (load "ctx2.lisp") ;; Loading file ctx2.lisp ... ** SILME ** The class #1=# has not yet been finalized. [Condition of type SIMPLE-ERROR] **** ; Evaluation aborted CL-USER> (compile-file "ctx2.lisp") ;; Compiling file D:\dev\code\lisp-systems\joe\ctx2.lisp ... 0 errors, 0 warnings ** SILME ** The class #1=# has not yet been finalized. [Condition of type SIMPLE-ERROR] **** ; Evaluation aborted CL-USER> As you can see, the first compilation is ok. But the complain of class not initialize comes after the first load. And then the subsequent compilation of the sam file also fails. I used CLISP 2.36. On Windows 2000. Note that I can still follow the example fine if I each form true REPL. It might have something to do with compile-time and load-time differences. From pc at p-cos.net Tue Dec 20 10:52:30 2005 From: pc at p-cos.net (Pascal Costanza) Date: Tue, 20 Dec 2005 11:52:30 +0100 Subject: [closer-devel] ContextL: Class not intialize In-Reply-To: References: Message-ID: <8CFB2918-3D0A-402C-9E77-1472DA1EE5C5@p-cos.net> Hi Joe, Thanks a lot for reporting this - it's a bug in ContextL. I have fixed it in the darcs repository. If you don't have darcs access, just change the following method in cx-special-class.lisp: (defmethod reinitialize-instance :before ((class special-class) &key) (when (class-finalized-p class) (setf (slot-value class 'old-slot-definitions) (class-slots class)))) The bug was that class-slots throws the error you reported when the class is not finalized. Fortunately, the code that depends on old- slot-definitions doesn't need to run when the class isn't finalized yet. I hope this helps, Pascal On 20 Dec 2005, at 10:18, JoeSB COE9 wrote: > Hi, > > I tried to follow ContextL overview document and got stuck. > Here is a part of example that got the error. > > ;;---------- ctx2.lisp > (defpackage :ctx2 > (:use :contextl)) > > (in-package :ctx2) > > (define-layered-class person () > ((name :initarg :name :accessor person-name))) > > (deflayer employment-layer) > > (define-layered-class person > :in-layer employment-layer () > ((employer :initarg :employer :layered-accessor person-employer))) > ;;---------- END ctx2.lisp > > And the REPL session goes like this > > CL-USER> (compile-file "ctx2.lisp") > ;; Compiling file D:\dev\code\lisp-systems\joe\ctx2.lisp ... > ;; Wrote file D:\dev\code\lisp-systems\joe\ctx2.fas > 0 errors, 0 warnings > #P"D:\\dev\\code\\lisp-systems\\joe\\ctx2.fas" > NIL > NIL > CL-USER> (load "ctx2.lisp") > ;; Loading file ctx2.lisp ... > ** SILME ** > The class #1=# :VERSION 2> has not yet been finalized. > [Condition of type SIMPLE-ERROR] > **** > ; Evaluation aborted > CL-USER> (compile-file "ctx2.lisp") > ;; Compiling file D:\dev\code\lisp-systems\joe\ctx2.lisp ... > 0 errors, 0 warnings > ** SILME ** > The class #1=# :VERSION 2> has not yet been finalized. > [Condition of type SIMPLE-ERROR] > **** > ; Evaluation aborted > CL-USER> > > As you can see, the first compilation is ok. But the complain of class > not initialize comes after the first load. And then the subsequent > compilation of the sam file also fails. > > I used CLISP 2.36. On Windows 2000. > > Note that I can still follow the example fine if I each form true > REPL. It might have something to do with compile-time and load-time > differences. > _______________________________________________ > closer-devel mailing list > closer-devel at common-lisp.net > http://common-lisp.net/cgi-bin/mailman/listinfo/closer-devel -- Pascal Costanza, mailto:pc at p-cos.net, http://p-cos.net Vrije Universiteit Brussel, Programming Technology Lab Pleinlaan 2, B-1050 Brussel, Belgium