(defpackage :Blah
(:use :cl))
(in-package :Blah)
(export '(test-ab test-cd))
(defclass A ()
((values :accessor values-of :allocation :class
:initform nil)))
;; can i do something similar to `virtual base class' in C++ here?
;; (if i remember how that works in c++ correcly)
(defclass B (A)
())
(defun test-ab ()
(dotimes (i 2)
(let ((a (make-instance 'A))
(b (make-instance 'B)))
(push 0 (values-of a))
(push 1 (values-of a))
(push 2 (values-of a))
(dolist (value (reverse (values-of a)))
(format t "test-ab, a: ~A~%" value))
(terpri)
(dolist (value (reverse (values-of b)))
(format t "test-ab, b: ~A~%" value))
(terpri))))
#| output
cl-user> (Blah:test-ab)
test-ab, a: 0
test-ab, a: 1
test-ab, a: 2
test-ab, b: 0
test-ab, b: 1
test-ab, b: 2
test-ab, a: 0
test-ab, a: 1
test-ab, a: 2
test-ab, a: 0
test-ab, a: 1
test-ab, a: 2
test-ab, b: 0
test-ab, b: 1
test-ab, b: 2
test-ab, b: 0
test-ab, b: 1
test-ab, b: 2
|#
;; this does what i need - and i guess i could do this with
;; macros so i didn't have to repeat the definition of the `value'-slot
in
;; subclasses:
(defclass C ()
((values :accessor values-of :allocation :class
:initform nil)))
(defclass D (C)
((values :accessor values-of :allocation :class
:initform nil)))
(defun test-cd ()
(dotimes (i 2)
(let ((c (make-instance 'C))
(d (make-instance 'D)))
(push 0 (values-of c))
(push 1 (values-of c))
(push 2 (values-of c))
(dolist (value (reverse (values-of c)))
(format t "test-cd, c: ~A~%" value))
(terpri)
(dolist (value (reverse (values-of d)))
(format t "test-cd, d: ~A~%" value))
(terpri))))
#| output:
cl-user> (Blah:test-cd)
test-cd, c: 0
test-cd, c: 1
test-cd, c: 2
test-cd, c: 0
test-cd, c: 1
test-cd, c: 2
test-cd, c: 0
test-cd, c: 1
test-cd, c: 2
|#
I guess I could get something like this by creating a macro named
`defsharedvalueclass' or somethinglikethat, but is this possible using
only CLOS?
--
mvh, Lars Rune Nøstdal
http://lars.nostdal.org/
I don't understand. Is this what you want, or is it not?
If that's not what you want, why have you shadowed the values class
attribute in D?
--
__Pascal Bourguignon__ http://www.informatimago.com/
This is a signature virus. Add me to your signature and help me to live.
So the problem is that VALUES-OF is shared with any class that inherits
from A? I am pretty sure that C++ does this too. Do you want each
class to have it's own VALUES-OF variable that is class allocated, but
inheritance doesn't effect it?
Cheers
Brad
(Note, not Lisp code :)
class A
{
public:
A() { count = 0; };
static int count;
};
int A::count = 0;
class B : public A {};
int main(int argc, _TCHAR* argv[])
{
A a;
B b;
a.count = 5;
printf ("%i %i\n", a.count, b.count);
return 0;
}
Yes, something like that. I think I'll just "give up" and use macros
for now:
(defmacro defvaluesharedclass (name superclasses slots &rest options)
`(defclass ,name ,superclasses
((values :accessor values-of :allocation :class
:initform nil)
,@slots)
,@options))
..or something, then:
Blah> (defvaluesharedclass Test ()
((a :accessor a-of)))
#<standard-class Test>
Blah> (defvaluesharedclass Test2 (Test)
((b :accessor b-of)))
#<standard-class Test2>
Blah> (defparameter *test* (make-instance 'Test))
*test*
Blah> (defparameter *test2* (make-instance 'Test2))
*test2*
Blah> (push 0 (values-of *test*))
(0)
Blah> (push 1 (values-of *test*))
(1 0)
Blah> (push 2 (values-of *test*))
(2 1 0)
Blah> (values-of *test*)
(2 1 0)
Blah> (values-of *test2*)
nil
Blah> (push 'a (values-of *test2*))
(a)
Blah> (values-of *test2*)
(a)
Blah> (values-of *test*)
(2 1 0)
Longer answer: The class allocation controls at what level the slot is
allocated. You right now have only two choices: class and instance.
If instance, then every instance has its own slot. If class, then the
slot is shared among all instances of that class (unless shadowed by
some lower-down instance or class allocated slot).
What you are looking for is perhaps something like an each-class
allocation, which Common Lisp doesn't support. You have to explicitly
tell CL which classes are supposed to have the slot allocated. There is
no automatic way to get this to happen.
So, your choices are either to write it at each class level, or else to
introduce your own class construction macro that does it for you.
=========
Trivial, off-topic comments follow:
Ob printing out the values. Why not just use
(format t "test-ab, b: ~A~%" (reverse (values-of a)))
and not bother with the loop. A printed list is just fine. You would
then get more compact output like
test-ab, a: (0 1 2)
test-ab, b: (0 1 2)
test-ab, a: (0 1 2 0 1 2)
test-ab, b: (0 1 2 0 1 2)
If you really want each value on a separte line, you could use the
format language's own list iterator:
(format t "~{test-ab, b: ~A~%~}" (reverse (values-of a)))
--
Thomas A. Russ, USC/Information Sciences Institute
So for CLOS (and LW for weak hash tables)
(defvar *a-values* (make-hash-table :weak-kind :key))
(defclass a ()
())
(defclass b (a)
())
(defmethod values-of ((obj a))
(gethash obj *a-values*))
(defmethod (setf values-of) (new-val (obj a))
(setf (gethash obj *a-values*) new-val))
CL-USER 1 > (defvar b (make-instance 'b))
B
CL-USER 2 > b
#<B 20673154>
CL-USER 3 > (values-of b)
NIL
NIL
CL-USER 4 > (push 0 (values-of b))
(0)
CL-USER 5 > (values-of b)
(0)
T
CL-USER 6 > (push 1 (values-of b))
(1 0)
CL-USER 7 > (push 2 (values-of b))
(2 1 0)
CL-USER 8 > (reverse (values-of b))
(0 1 2)
CL-USER 9 >
(defvar *a-values* nil)
(defclass a ()
())
(defclass b (a)
())
(defmethod values-of ((obj a))
*a-values*)
(defmethod (setf values-of) (new-val (obj a))
(setf *a-values* new-val))
Wade
> Even C++ has deprecated static "class" members, they now seem to
> use statics within a namespace.
Could you provide a link supporting this statement?
Regards,
Marco
Kenny won't like this, but it's possible to do this with the CLOS MOP in
a relatively straightforward way:
(defclass values-class (standard-class)
((values :accessor values-of :initform nil)))
(defmethod validate-superclass
((class values-class)
(superclass standard-class))
t)
(defclass A () ()
(:metaclass values-class))
(defclass B (A) ()
(:metaclass values-class))
(defun test ()
(let ((a (make-instance 'A))
(b (make-instance 'B)))
(setf (values-of (class-of a)) 42)
(print (values-of (class-of a)))
(print (values-of (class-of b)))))
Pascal
--
3rd European Lisp Workshop
July 3 - Nantes, France - co-located with ECOOP 2006
http://lisp-ecoop06.bknr.net/
Cool, this seems to work -- thank you :)
(defclass values-class (standard-class)
((values :initform nil)))
(defmethod sb-mop:validate-superclass
((class values-class)
(superclass standard-class))
t)
(defclass A () ()
(:metaclass values-class))
(defmethod values-of ((obj A))
(slot-value (class-of obj) 'values))
(defmethod (setf values-of) (new-value (obj A))
(setf (slot-value (class-of obj) 'values)
new-value))
(defclass B (A) ()
(:metaclass values-class))
(defun test ()
(dotimes (i 2)
(let ((a (make-instance 'A))
(b (make-instance 'B)))
(push (random 3) (values-of a))
(format t "a: ~A~%" (values-of a))
(format t "b: ~A~%" (values-of b)))))
..i should read this AMOP-book i bought .... :)
Pascal Costanza wrote:
> Lars Rune Nřstdal wrote:
>
>> Ok, I'm not sure i remember the "virtual base class"-stuff from c++
>> that well, but I think I'm after an effect similar to that, only using
>> Common Lisp of course. It's what happens in `test-cd' I'm after, but
>> I'm hoping there is a way to do that without having to define the
>> `value'-slot in every subclass of `C'.
>
>
> Kenny won't like this, but it's possible to do this...
Awareness of defect is the first step to recovery.
You are correct in one respect: no, no one has any idea why a Lisp newby
wants some feature, and all anyone can do is talk about the feature
requested and how to fake it. But in this case the feature is not out in
left field, so the alarms are not going off.
Still, it /would/ be a courtesy to ask what they are up to in case there
is some idiomatic Lisp Way to achieve it.
Overall, I am not at all worried: Lars is already a Cells user.
Something tells me he will do OK with Lisp.
:)
kt
ps. Putting the slot in the class was pretty icky. Is there no way to
insert a slot definition in the class being defined? k
--
Cells: http://common-lisp.net/project/cells/
"I'll say I'm losing my grip, and it feels terrific."
-- Smiling husband to scowling wife, New Yorker cartoon
I was pretty sure that that Sun's C++ compiler gave me a warning
not to do it. But checking it out at work today I could not
recreate the situation. Oh well, it may be my memory acting up
and getting some C# issues overlayed.
Wade
OK, I'm relieved to hear that. After all the discussions about
removing lambda from Python I probably got a bit paranoid :-)
Marco