[closer-devel] Redefining classes
Pascal Costanza
pc at p-cos.net
Thu Dec 1 20:43:55 UTC 2005
Hi Michael,
On 1 Dec 2005, at 20:27, Michael Weber wrote:
> * Pascal Costanza <pc at p-cos.net> [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 #<EQL-CLASS BAR-1>)
> 0: FINALIZE-INHERITANCE returned NIL
> ;;;; (define-eql-class bar-1 (bar) ((slot-3 :initarg :slot-3 ...
>
> CL-USER> (make-instance 'bar-1)
> #<BAR-1 {916B1A9}>
> 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 #<EQL-CLASS BAR>)
> ;;;; (define-eql-class bar () ((slot-1 :reader slot-1 ...
> (SHARED-INITIALIZE #<EQL-CLASS BAR>)
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)))
>
> #<EQL-CLASS BAR>
>
> 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 #<BAR-1 {9E4D739}>.
> [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
More information about the closer-devel
mailing list