Inherited shared slots
Erann Gat
Here's a puzzle for you CLOS and MOP wizards. Is there a way to have
a slot variable that is inherited as a class allocated variable in the
sub-class? i.e. is it possible to create an abstract class C such that
if a class C1 inherits from C it inherits a slot S that is class-allocated
in C1, not C?
What I am tring to do is implement a set of typed container/component
classes. Each component class keeps track of the types of
containers it can be contained by. I want to define a single global
INSERT method defined on the abstract COMPONENT class. This method
has to check the LEGAL-CONTAINER-TYPES slot to make sure that the
insertion is legal, but this slot must be class-allocated in each
class that inherits from COMPONENT because different kinds of
components can be inserted in different kinds of containers.
BTW, I know I could implement this with an instance-allocated
LEGAL-CONTAINER-TYPES slot, or with a DEFINE-COMPONENT-CLASS macro.
I'm trying to figure out if there is a way to do it that is both
efficient and elegant.
Thanks,
Erann Gat
g...@jpl.nasa.gov
--
Erann Gat gat @ jpl.nasa.gov gat @ jetcafe.org
Furious activity is no substitute for understanding.
-- H. H. Williams
Erik Naggum
* Erann Gat
| Here's a puzzle for you CLOS and MOP wizards.
I'll try to answer, anyway.
| Is there a way to have a slot variable that is inherited as a class
| allocated variable in the sub-class?
sorry to be so elaborate, but do you mean as in this example:
(defclass foo ()
((zot :allocation :class)))
(defclass bar (foo)
())
that
(eq (setf (slot-value (make-instance 'bar) 'zot) (cons nil nil))
(slot-value (make-instance 'bar) 'zot))
should yield T?
if so, you're in luck, because this is already the specified behavior of
shared slots, _unless_ you create a new slot with the same name. here's
what the HyperSpec says on this issue (7.5.3):
A consequence of the allocation rule is that a shared slot can be
shadowed. For example, if a class C1 defines a slot named S whose
value for the :allocation slot option is :class, that slot is
accessible in instances of C1 and all of its subclasses. However, if
C2 is a subclass of C1 and also defines a slot named S, C1's slot is
not shared by instances of C2 and its subclasses. When a class C1
defines a shared slot, any subclass C2 of C1 will share this single
slot unless the defclass form for C2 specifies a slot of the same name
or there is a superclass of C2 that precedes C1 in the class precedence
list of C2 that defines a slot of the same name.
hope this helps.
#:Erik
--
religious cult update in light of new scientific discoveries:
"when we cannot go to the comet, the comet must come to us."
Erann Gat
> * Erann Gat
> | Here's a puzzle for you CLOS and MOP wizards.
>
> I'll try to answer, anyway.
>
> | Is there a way to have a slot variable that is inherited as a class
> | allocated variable in the sub-class?
>
> sorry to be so elaborate, but do you mean as in this example:
>
> (defclass foo ()
> ((zot :allocation :class)))
>
> (defclass bar (foo)
> ())
>
> that
>
> (eq (setf (slot-value (make-instance 'bar) 'zot) (cons nil nil))
> (slot-value (make-instance 'bar) 'zot))
>
> should yield T?
Almost. In also want a second class, baz, that inherits from foo
to have a shared slot that is distinct from the one shared by all
instances of bar. i.e. if I do:
(defclass baz (foo) ())
then
(eq (setf (slot-value (make-instance 'baz) 'zot) (cons nil nil))
(slot-value (make-instance 'bar) 'zot))
should return nil.
E.
Erik Naggum
* Erann Gat
| Almost. In also want a second class, baz, that inherits from foo
| to have a shared slot that is distinct from the one shared by all
| instances of bar. i.e. if I do:
|
| (defclass baz (foo) ())
|
| then
|
| (eq (setf (slot-value (make-instance 'baz) 'zot) (cons nil nil))
| (slot-value (make-instance 'bar) 'zot))
|
| should return nil.
continuing the example,
(defclass baz (foo)
((zot :allocation :class :initform ())))
should do that.
Kent M Pitman
Erik Naggum <cle...@naggum.no> writes:
> * Erann Gat
> | Almost. In also want a second class, baz, that inherits from foo
> | to have a shared slot that is distinct from the one shared by all
> | instances of bar.
>
> (defclass baz (foo)
> ((zot :allocation :class :initform ())))
Well, yeah, but...
I think the question he's asking is whether Common Lisp has what the
Dylan language calls :allocation :each-subclass, and the answer is no.
Pity. I personally think :allocation :class is almost always wrong,
and :each-subclass would have been infinitely more useful.
dan corkill
In article <sfwogy3...@world.std.com>,
Kent M Pitman <pit...@world.std.com> wrote:
>I think the question he's asking is whether Common Lisp has what the
>Dylan language calls :allocation :each-subclass, and the answer is no.
>Pity. I personally think :allocation :class is almost always wrong,
>and :each-subclass would have been infinitely more useful.
I agree! We implemented a :class-per-class allocation option for
GBB for exactly this reason and lobbied for it (along with a slot-name
accessor for structures) early in the standardization process.
Both are still needed...
-- Dan Corkill
Blackboard Technology
Erann Gat
> Erik Naggum <cle...@naggum.no> writes:
>
> > * Erann Gat
> > | Almost. In also want a second class, baz, that inherits from foo
> > | to have a shared slot that is distinct from the one shared by all
> > | instances of bar.
> >
> > (defclass baz (foo)
> > ((zot :allocation :class :initform ())))
>
> Well, yeah, but...
>
> I think the question he's asking is whether Common Lisp has what the
> Dylan language calls :allocation :each-subclass, and the answer is no.
> Pity. I personally think :allocation :class is almost always wrong,
> and :each-subclass would have been infinitely more useful.
That's exactly what I was asking. Isn't there some way to implement
:allocation :each-subclass using the MOP? I thought the MOP could
do anything ;-)
E.
--
Erann Gat gat at jpl.nasa.gov or gat at jetcafe.org
Kelly Murray
In article <gat-170498...@milo.jpl.nasa.gov>, g...@jpl.nasa.gov (Erann Gat) writes:
>> In article <sfwogy3...@world.std.com>, Kent M Pitman
>>
>> > Dylan language calls :allocation :each-subclass, and the answer is no.
>> > Pity. I personally think :allocation :class is almost always wrong,
>> > and :each-subclass would have been infinitely more useful.
>>
>> That's exactly what I was asking. Isn't there some way to implement
>> :allocation :each-subclass using the MOP? I thought the MOP could
>> do anything ;-)
>>
Sure the MOP could be used to implement it.
The question was asking for a more efficient and ELEGANT solution...
Even at the surface level, I don't see that
(defclass thing1 (thing-mixin-class-slots)
(..)
(:metaclass non-standard-class)
)
is any more elegant than
(define-thing-class thing1 ()
( .. )
)
which can be implemented without the MOP.
Generally, I believe the :each-class allocation should be included
as part of CLOS itself.
-Kelly Murray k...@franz.com
Francis Leboutte
g...@jpl.nasa.gov (Erann Gat) wrote:
>In article <sfwogy3...@world.std.com>, Kent M Pitman
><pit...@world.std.com> wrote:
>
[snip]
>> I think the question he's asking is whether Common Lisp has what the
>> Dylan language calls :allocation :each-subclass, and the answer is no.
>> Pity. I personally think :allocation :class is almost always wrong,
>> and :each-subclass would have been infinitely more useful.
>
>That's exactly what I was asking. Isn't there some way to implement
>:allocation :each-subclass using the MOP? I thought the MOP could
>do anything ;-)
Below a code snipset that adds a shared %counter slot to each class defined
on the 'basic-class' metaclass (thanks to A.Paepcke - Object-Oriented
Programming, MIT Press). Maybe you could start from this to implement
something more general.
(defclass basic-class (standard-class)
())
(defmethod validate-superclass ((class basic-class) (superclass
standard-class))
T)
(defclass basic-mixin ()
((%counter :initform 0 :accessor %counter :allocation :class))
(:metaclass standard-class)
(:documentation
"a service mixin class to be inherited by all basic-class based
classes"))
(defmethod initialize-instance :after ((basic-instance basic-mixin) &rest
all-keys)
(incf (%counter basic-instance)))
;;; redefines the :class %counter slot for each class based on basic-class
;;; -> each basic-class class has its own shared %counter slot
(defmethod ensure-class-using-class :around (class
name
&rest all-keys
&key
metaclass
direct-slots
&allow-other-keys)
(cond ((eq metaclass 'basic-class))
#+never
(when (find '%counter direct-slots :key #'second :test #'eq)
(setf direct-slots
(remove '%counter direct-slots :key #'second :test
#'eq)))
(apply #'call-next-method class name
:direct-slots
(cons `(:name %counter :initform 0
:initfunction ,#'(lambda () 0)
:writers ((setf %counter)) :readers (%counter)
:allocation :class )
direct-slots)
all-keys))
(T (call-next-method))))
(defmacro ensure-a-inherited-class (class
meta-class-name
associated-mixin-name
direct-superclasses all-keys
&optional most-specific?)
"Class is a class instance based on the Meta-Class-Name metaclass.
Ensures that the associated-mixin will be in the precedence list.
Most-Specific? : possibly controls the associated-mixin position in the
precedence list"
`(let ((associated-mixin-name-class (find-class ,associated-mixin-name))
(meta-class-name-class (find-class ,meta-class-name)))
(cond ((member-if #'(lambda (super)
(eq (class-of super) meta-class-name-class))
,direct-superclasses)
(call-next-method))
;; the associated-mixin is not present through inheritance ->
add it
(T
(apply #'call-next-method
,class
:direct-superclasses
(if ,most-specific?
(cons associated-mixin-name-class ,direct-superclasses)
(append ,direct-superclasses (list
associated-mixin-name-class)))
,all-keys)))))
;; to make all basic-class classes ineherit from the basic-mixin class
(defmethod initialize-instance :around ((class basic-class)
&rest all-keys
&key
direct-superclasses)
(ensure-a-inherited-class class 'basic-class 'basic-mixin
direct-superclasses all-keys))
--
Francis Leboutte
f.leb...@skynet.be lebo...@acm.org http://users.skynet.be/algo
Marre du courrier non sollicité (spam)? Visitez http://www.cauce.org
Francis Leboutte
co...@cs.umass.edu (dan corkill) wrote:
>In article <sfwogy3...@world.std.com>,
>Kent M Pitman <pit...@world.std.com> wrote:
>
>>I think the question he's asking is whether Common Lisp has what the
>>Dylan language calls :allocation :each-subclass, and the answer is no.
>>Pity. I personally think :allocation :class is almost always wrong,
>>and :each-subclass would have been infinitely more useful.
>
>I agree! We implemented a :class-per-class allocation option for
>GBB for exactly this reason and lobbied for it (along with a slot-name
>accessor for structures) early in the standardization process.
>
>Both are still needed...
>
It seems that a lot of us want these 2 features. I would like that the Lisp
vendors show initiative...
Francis