How can you add a new slot to an existing class? Meaning that if i
have an existing class, with no source code so that i cannot redefine
it with the new slot added, how can i add a new slot to that class.
This is something in the lines of the so called class extensions.
Could this be solved with some MOP-programming?
Adrian DOZSA wrote:
> How can you add a new slot to an existing class? Meaning that if i
> have an existing class, with no source code so that i cannot redefine
> it with the new slot added, how can i add a new slot to that class.
> This is something in the lines of the so called class extensions.
> Could this be solved with some MOP-programming?
Yes, but it's not straightforward.
You have to do a reinitalize-instance on the class metaobject and pass
it a new initialization for :direct-slots. Since you can only modify the
_complete_ set of direct slots, you first have to call
class-direct-slots and have to reconstruct the parameter from the
readers for each slot return. This is very cumbersome and error prone.
The problem is, if you do something wrong here, you can mess up the
whole system. (I have done something like that in AspectL, as part of
what is called destructive mixins in there.)
My strong recommendation is stay away from this approach and try
something simpler. For example, you could simply define a method on
(ANSI-defined) slot-missing and perform a lookup of additional
information in some (possibly weak) hashtable. Or define methods with
eql specializers on the objects you're interested in.
Another way would be to use ContextL and define your classes as layered.
Then you can always add new slots in a declarative way by defining new
layers and adding slots to an existing class in such new layers.
However, that requires access to the source code of the original
definitions.
Pascal
--
1st European Lisp Symposium (ELS'08)
http://prog.vub.ac.be/~pcostanza/els08/
My website: http://p-cos.net
Common Lisp Document Repository: http://cdr.eurolisp.org
Closer to MOP & ContextL: http://common-lisp.net/project/closer/
In article <···············@mid.individual.net>,
Pascal Costanza <··@p-cos.net> wrote:
> Adrian DOZSA wrote:
> > How can you add a new slot to an existing class? Meaning that if i
> > have an existing class, with no source code so that i cannot redefine
> > it with the new slot added, how can i add a new slot to that class.
> > This is something in the lines of the so called class extensions.
> > Could this be solved with some MOP-programming?
>
> Yes, but it's not straightforward.
It can be if you're willing to be sneaky:
? (defclass foo () (x))
#<STANDARD-CLASS FOO>
? (defclass baz (foo) (y))
#<STANDARD-CLASS BAZ>
? (setf (find-class 'foo) (find-class 'baz)) ; This is the sneaky bit
#<STANDARD-CLASS BAZ>
? (make-instance 'foo)
#<BAZ #x30004239FE3D>
? (describe *)
#<BAZ #x30004239FE3D>
Class: #<STANDARD-CLASS BAZ>
Wrapper: #<CLASS-WRAPPER #x30004232F88D>
Instance slots
X: #<Unbound>
Y: #<Unbound>
rg
Ron Garret wrote:
> In article <···············@mid.individual.net>,
> Pascal Costanza <··@p-cos.net> wrote:
>
>> Adrian DOZSA wrote:
>>> How can you add a new slot to an existing class? Meaning that if i
>>> have an existing class, with no source code so that i cannot redefine
>>> it with the new slot added, how can i add a new slot to that class.
>>> This is something in the lines of the so called class extensions.
>>> Could this be solved with some MOP-programming?
>> Yes, but it's not straightforward.
>
> It can be if you're willing to be sneaky:
>
> ? (defclass foo () (x))
> #<STANDARD-CLASS FOO>
> ? (defclass baz (foo) (y))
> #<STANDARD-CLASS BAZ>
> ? (setf (find-class 'foo) (find-class 'baz)) ; This is the sneaky bit
> #<STANDARD-CLASS BAZ>
> ? (make-instance 'foo)
> #<BAZ #x30004239FE3D>
> ? (describe *)
> #<BAZ #x30004239FE3D>
> Class: #<STANDARD-CLASS BAZ>
> Wrapper: #<CLASS-WRAPPER #x30004232F88D>
> Instance slots
> X: #<Unbound>
> Y: #<Unbound>
Yes, but this doesn't update any existing instances of the class foo...
Pascal
--
1st European Lisp Symposium (ELS'08)
http://prog.vub.ac.be/~pcostanza/els08/
My website: http://p-cos.net
Common Lisp Document Repository: http://cdr.eurolisp.org
Closer to MOP & ContextL: http://common-lisp.net/project/closer/
In article <···············@mid.individual.net>,
Pascal Costanza <··@p-cos.net> wrote:
> Ron Garret wrote:
> > In article <···············@mid.individual.net>,
> > Pascal Costanza <··@p-cos.net> wrote:
> >
> >> Adrian DOZSA wrote:
> >>> How can you add a new slot to an existing class? Meaning that if i
> >>> have an existing class, with no source code so that i cannot redefine
> >>> it with the new slot added, how can i add a new slot to that class.
> >>> This is something in the lines of the so called class extensions.
> >>> Could this be solved with some MOP-programming?
> >> Yes, but it's not straightforward.
> >
> > It can be if you're willing to be sneaky:
> >
> > ? (defclass foo () (x))
> > #<STANDARD-CLASS FOO>
> > ? (defclass baz (foo) (y))
> > #<STANDARD-CLASS BAZ>
> > ? (setf (find-class 'foo) (find-class 'baz)) ; This is the sneaky bit
> > #<STANDARD-CLASS BAZ>
> > ? (make-instance 'foo)
> > #<BAZ #x30004239FE3D>
> > ? (describe *)
> > #<BAZ #x30004239FE3D>
> > Class: #<STANDARD-CLASS BAZ>
> > Wrapper: #<CLASS-WRAPPER #x30004232F88D>
> > Instance slots
> > X: #<Unbound>
> > Y: #<Unbound>
>
> Yes, but this doesn't update any existing instances of the class foo...
You have to be sneaky at the right time ;-)
Actually, that's pretty straightforward to solve because the two classes
aren't actually identical. Anywhere you have an object that might be an
instance of old-foo just check if it is and if so CHANGE-CLASS it to
make it a new-foo.
rg
On Feb 17, 7:43 pm, Ron Garret <·········@flownet.com> wrote:
> In article <···············@mid.individual.net>,
> Pascal Costanza <····@p-cos.net> wrote:
>
> > Adrian DOZSA wrote:
> > > How can you add a new slot to an existing class? Meaning that if i
> > > have an existing class, with no source code so that i cannot redefine
> > > it with the new slot added, how can i add a new slot to that class.
> > > This is something in the lines of the so called class extensions.
> > > Could this be solved with some MOP-programming?
>
> > Yes, but it's not straightforward.
>
> It can be if you're willing to be sneaky:
>
> ? (defclass foo () (x))
> #<STANDARD-CLASS FOO>
> ? (defclass baz (foo) (y))
> #<STANDARD-CLASS BAZ>
> ? (setf (find-class 'foo) (find-class 'baz)) ; This is the sneaky bit
> #<STANDARD-CLASS BAZ>
> ? (make-instance 'foo)
> #<BAZ #x30004239FE3D>
> ? (describe *)
> #<BAZ #x30004239FE3D>
> Class: #<STANDARD-CLASS BAZ>
> Wrapper: #<CLASS-WRAPPER #x30004232F88D>
> Instance slots
> X: #<Unbound>
> Y: #<Unbound>
>
> rg
What would be the effect (problems that could occur) of trying to do
this on classes like standard-class or standard-method or even
standard-object?
In article
<····································@c33g2000hsd.googlegroups.com>,
Adrian DOZSA <·········@gmail.com> wrote:
> On Feb 17, 7:43 pm, Ron Garret <·········@flownet.com> wrote:
> > In article <···············@mid.individual.net>,
> > Pascal Costanza <····@p-cos.net> wrote:
> >
> > > Adrian DOZSA wrote:
> > > > How can you add a new slot to an existing class? Meaning that if i
> > > > have an existing class, with no source code so that i cannot redefine
> > > > it with the new slot added, how can i add a new slot to that class.
> > > > This is something in the lines of the so called class extensions.
> > > > Could this be solved with some MOP-programming?
> >
> > > Yes, but it's not straightforward.
> >
> > It can be if you're willing to be sneaky:
> >
> > ? (defclass foo () (x))
> > #<STANDARD-CLASS FOO>
> > ? (defclass baz (foo) (y))
> > #<STANDARD-CLASS BAZ>
> > ? (setf (find-class 'foo) (find-class 'baz)) ; This is the sneaky bit
> > #<STANDARD-CLASS BAZ>
> > ? (make-instance 'foo)
> > #<BAZ #x30004239FE3D>
> > ? (describe *)
> > #<BAZ #x30004239FE3D>
> > Class: #<STANDARD-CLASS BAZ>
> > Wrapper: #<CLASS-WRAPPER #x30004232F88D>
> > Instance slots
> > X: #<Unbound>
> > Y: #<Unbound>
> >
> > rg
>
>
> What would be the effect (problems that could occur) of trying to do
> this on classes like standard-class or standard-method or even
> standard-object?
Beats me. Give it a try and see what happens.
rg
On Feb 18, 9:02 pm, Ron Garret <·········@flownet.com> wrote:
> In article
> <····································@c33g2000hsd.googlegroups.com>,
> Adrian DOZSA <·········@gmail.com> wrote:
>
>
>
> > On Feb 17, 7:43 pm, Ron Garret <·········@flownet.com> wrote:
> > > In article <···············@mid.individual.net>,
> > > Pascal Costanza <····@p-cos.net> wrote:
>
> > > > Adrian DOZSA wrote:
> > > > > How can you add a new slot to an existing class? Meaning that if i
> > > > > have an existing class, with no source code so that i cannot redefine
> > > > > it with the new slot added, how can i add a new slot to that class.
> > > > > This is something in the lines of the so called class extensions.
> > > > > Could this be solved with some MOP-programming?
>
> > > > Yes, but it's not straightforward.
>
> > > It can be if you're willing to be sneaky:
>
> > > ? (defclass foo () (x))
> > > #<STANDARD-CLASS FOO>
> > > ? (defclass baz (foo) (y))
> > > #<STANDARD-CLASS BAZ>
> > > ? (setf (find-class 'foo) (find-class 'baz)) ; This is the sneaky bit
> > > #<STANDARD-CLASS BAZ>
> > > ? (make-instance 'foo)
> > > #<BAZ #x30004239FE3D>
> > > ? (describe *)
> > > #<BAZ #x30004239FE3D>
> > > Class: #<STANDARD-CLASS BAZ>
> > > Wrapper: #<CLASS-WRAPPER #x30004232F88D>
> > > Instance slots
> > > X: #<Unbound>
> > > Y: #<Unbound>
>
> > > rg
>
> > What would be the effect (problems that could occur) of trying to do
> > this on classes like standard-class or standard-method or even
> > standard-object?
>
> Beats me. Give it a try and see what happens.
>
> rg
Trying out the idea on the MOP classes themselves.
In LispWorks: (find-class 'standard-class) generates an Stack overflow
(weird!) Find-ing any MOP class does the same.
In SBCL: (setf (find-class 'standard-class) (find-class 'my-standard-
class)) gives a SYMBOL-PACKAGE-LOCKED-ERROR (Lock on package COMMON-
LISP violated when using STANDARD-CLASS as the class-name argument in
(SETF FIND-CLASS) ). So you're not allowed to mess with them.
In Allegro CL: the setf works fine; but when i try to define simple
class i get: "Error: Recursive error while printing or signalling an
error. This is sometimes caused by an error in a print-object
method."; something is clearly not right.
So this solution doesn't seem to work for system/MOP classes.
Anyway, thanks for the ideas.
From: Edi Weitz
Subject: Re: how to add a new slot to an existing class
Date:
Message-ID: <u1w7aynq4.fsf@agharta.de>
On Mon, 18 Feb 2008 13:04:25 -0800 (PST), Adrian DOZSA <·········@gmail.com> wrote:
> In LispWorks: (find-class 'standard-class) generates an Stack
> overflow (weird!) Find-ing any MOP class does the same.
I can't reproduce that:
CL-USER 1 > (find-class 'standard-class)
#<STANDARD-CLASS STANDARD-CLASS 2093E313>
CL-USER 2 > (find-class 'clos:funcallable-standard-object)
#<STANDARD-CLASS CLOS:FUNCALLABLE-STANDARD-OBJECT 2093BE1F>
If you can, I'd suggest you send a bug report to LispWorks.
Edi.
--
European Common Lisp Meeting, Amsterdam, April 19/20, 2008
http://weitz.de/eclm2008/
Real email: (replace (subseq ·········@agharta.de" 5) "edi")
On Feb 18, 11:10 pm, Edi Weitz <········@agharta.de> wrote:
> On Mon, 18 Feb 2008 13:04:25 -0800 (PST), Adrian DOZSA <·········@gmail.com> wrote:
> > In LispWorks: (find-class 'standard-class) generates an Stack
> > overflow (weird!) Find-ing any MOP class does the same.
>
> I can't reproduce that:
>
> CL-USER 1 > (find-class 'standard-class)
> #<STANDARD-CLASS STANDARD-CLASS 2093E313>
>
> CL-USER 2 > (find-class 'clos:funcallable-standard-object)
> #<STANDARD-CLASS CLOS:FUNCALLABLE-STANDARD-OBJECT 2093BE1F>
>
> If you can, I'd suggest you send a bug report to LispWorks.
>
> Edi.
>
> --
>
> European Common Lisp Meeting, Amsterdam, April 19/20, 2008
>
> http://weitz.de/eclm2008/
>
> Real email: (replace (subseq ·········@agharta.de" 5) "edi")
The stack overflow happend only after this: (setf (find-class
'standard-class) (find-class 'my-standard-class))
And unfortunately it's not always reproducible. If it works then the
next class definition fails in strange ways.
Adrian DOZSA <·········@gmail.com> writes:
> Trying out the idea on the MOP classes themselves.
>
> In LispWorks: (find-class 'standard-class) generates an Stack overflow
> (weird!) Find-ing any MOP class does the same.
This may be due to *PRINT-CIRCLE* being NIL and some other print
option or default making LispWorks print classes with more info than
just the class name.
Try: (progn (setf *print-circle* t) (find-class 'standard-class))
--
__Pascal Bourguignon__ http://www.informatimago.com/
Our enemies are innovative and resourceful, and so are we. They never
stop thinking about new ways to harm our country and our people, and
neither do we. -- Georges W. Bush
Adrian DOZSA wrote:
> On Feb 17, 7:43 pm, Ron Garret <·········@flownet.com> wrote:
>> In article <···············@mid.individual.net>,
>> Pascal Costanza <····@p-cos.net> wrote:
>>
>>> Adrian DOZSA wrote:
>>>> How can you add a new slot to an existing class? Meaning that if i
>>>> have an existing class, with no source code so that i cannot redefine
>>>> it with the new slot added, how can i add a new slot to that class.
>>>> This is something in the lines of the so called class extensions.
>>>> Could this be solved with some MOP-programming?
>>> Yes, but it's not straightforward.
>> It can be if you're willing to be sneaky:
>>
>> ? (defclass foo () (x))
>> #<STANDARD-CLASS FOO>
>> ? (defclass baz (foo) (y))
>> #<STANDARD-CLASS BAZ>
>> ? (setf (find-class 'foo) (find-class 'baz)) ; This is the sneaky bit
>> #<STANDARD-CLASS BAZ>
>> ? (make-instance 'foo)
>> #<BAZ #x30004239FE3D>
>> ? (describe *)
>> #<BAZ #x30004239FE3D>
>> Class: #<STANDARD-CLASS BAZ>
>> Wrapper: #<CLASS-WRAPPER #x30004232F88D>
>> Instance slots
>> X: #<Unbound>
>> Y: #<Unbound>
>>
>> rg
>
>
> What would be the effect (problems that could occur) of trying to do
> this on classes like standard-class or standard-method or even
> standard-object?
Don't do that! Not even in your dreams! ;)
Pascal
--
1st European Lisp Symposium (ELS'08)
http://prog.vub.ac.be/~pcostanza/els08/
My website: http://p-cos.net
Common Lisp Document Repository: http://cdr.eurolisp.org
Closer to MOP & ContextL: http://common-lisp.net/project/closer/
On Feb 19, 1:14 am, Pascal Costanza <····@p-cos.net> wrote:
> Adrian DOZSA wrote:
> > On Feb 17, 7:43 pm, Ron Garret <·········@flownet.com> wrote:
> >> In article <···············@mid.individual.net>,
> >> Pascal Costanza <····@p-cos.net> wrote:
>
> >>> Adrian DOZSA wrote:
> >>>> How can you add a new slot to an existing class? Meaning that if i
> >>>> have an existing class, with no source code so that i cannot redefine
> >>>> it with the new slot added, how can i add a new slot to that class.
> >>>> This is something in the lines of the so called class extensions.
> >>>> Could this be solved with some MOP-programming?
> >>> Yes, but it's not straightforward.
> >> It can be if you're willing to be sneaky:
>
> >> ? (defclass foo () (x))
> >> #<STANDARD-CLASS FOO>
> >> ? (defclass baz (foo) (y))
> >> #<STANDARD-CLASS BAZ>
> >> ? (setf (find-class 'foo) (find-class 'baz)) ; This is the sneaky bit
> >> #<STANDARD-CLASS BAZ>
> >> ? (make-instance 'foo)
> >> #<BAZ #x30004239FE3D>
> >> ? (describe *)
> >> #<BAZ #x30004239FE3D>
> >> Class: #<STANDARD-CLASS BAZ>
> >> Wrapper: #<CLASS-WRAPPER #x30004232F88D>
> >> Instance slots
> >> X: #<Unbound>
> >> Y: #<Unbound>
>
> >> rg
>
> > What would be the effect (problems that could occur) of trying to do
> > this on classes like standard-class or standard-method or even
> > standard-object?
>
> Don't do that! Not even in your dreams! ;)
>
> Pascal
>
> --
> 1st European Lisp Symposium (ELS'08)http://prog.vub.ac.be/~pcostanza/els08/
>
> My website:http://p-cos.net
> Common Lisp Document Repository:http://cdr.eurolisp.org
> Closer to MOP & ContextL:http://common-lisp.net/project/closer/
Ok, i shouldn't play with the MOP like this. But then how could i
solve my problem.
I want to add some new informations to each new class that it's added
to the system (also methods, generic functions, etc) - for some
program analysis purposes. The place that i think/want that
information to go is in the meta-class. So i want to add some new
fields to the meta-class. This could also be solved with a hash or
something similar for book-keeping, but this solution is far less
elegant compared to the the first one. So, any ideas on how to do this?
Adrian DOZSA wrote:
> I want to add some new informations to each new class that it's added
> to the system (also methods, generic functions, etc) - for some
> program analysis purposes. The place that i think/want that
> information to go is in the meta-class. So i want to add some new
> fields to the meta-class. This could also be solved with a hash or
> something similar for book-keeping, but this solution is far less
> elegant compared to the the first one. So, any ideas on how to do this?
I already gave you some hints about possible solutions in another post
in this thread. But you seem to really want to attach information to
classes that are otherwise not under your control. You're leaving the
officially approved functionality of CLOS and its MOP there, though.
(And that's a good thing, because if other libraries would do the same
as you intend to do, you would inevitably become conflicts that are hard
or impossible to resolve.)
Anyway, if you're still happy with that, the hooks to use are
ensure-class-using-class, initialize-instance on standard-class and/or
reinitialize-instance on standard-class. You could define :around
methods on those (after checking whether there aren't already :around
methods defined on those for standard-class), and sneak in some extra
slots or (probably better) an extra direct superclass which adds the
information you want (and hope that the CLOS implementation doesn't
ignore your :around methods, which it would be allowed to do according
to the CLOS MOP specification).
But keep in mind that you're on your own here. The specs don't support
such kind of hackery.
Good luck. ;-)
Pascal
--
1st European Lisp Symposium (ELS'08)
http://prog.vub.ac.be/~pcostanza/els08/
My website: http://p-cos.net
Common Lisp Document Repository: http://cdr.eurolisp.org
Closer to MOP & ContextL: http://common-lisp.net/project/closer/
Adrian DOZSA wrote:
> How can you add a new slot to an existing class? Meaning that if i
> have an existing class, with no source code so that i cannot
> redefine it with the new slot added, how can i add a new slot to
> that class. This is something in the lines of the so
Here's another possibility, how about recovering the original defclass
definition?
Hope the indentation comes out ok.
(defun get-source (class)
`(defclass ,(class-name class) ,(mapcar #'class-name (sb-mop:class-
direct-superclasses class))
,(loop for slot in (sb-mop:class-direct-slots class)
collect
(flet ((a (s) (funcall s slot)))
(append
(list
(a #'sb-mop:slot-definition-name)
:initargs (a #'sb-mop:slot-definition-initargs)
:initform (a #'sb-mop:slot-definition-initform)
:type (a #'sb-mop:slot-definition-type)
:allocation (a #'sb-mop:slot-definition-allocation))
(mapcan (lambda (x) (list :reader x))
(sb-mop:slot-definition-readers slot))
(mapcan (lambda (x) (list :writer x))
(sb-mop:slot-definition-writers slot)))))))
You'll of course need to use the appropriate implementation dependent
mop
package, or the closer-mop compatibility layer.
Example usage:
(defclass myclass (standard-object)
((a)
(b :initargs (:b :c)
:writer b1
:writer b2)))
CL-USER> (get-source (find-class 'myclass))
(DEFCLASS MYCLASS
(STANDARD-OBJECT)
((A :INITARGS NIL :INITFORM NIL :TYPE
T :ALLOCATION :INSTANCE)
(B :INITARGS NIL :INITFORM NIL :TYPE
T :ALLOCATION :INSTANCE
:WRITER B2 :WRITER B1)))
You can then modify and use that as appropriate. (the code may be
incomplete -- default-initargs, metaclass etc class-options still need
to be looked up)
Da MOP is cool. Get MOPping! :)
From: Edi Weitz
Subject: Re: how to add a new slot to an existing class
Date:
Message-ID: <u4pc61at4.fsf@agharta.de>
On Mon, 18 Feb 2008 02:52:19 -0800 (PST), szergling <···············@gmail.com> wrote:
> (defun get-source (class)
> `(defclass ,(class-name class) ,(mapcar #'class-name (sb-mop:class-direct-superclasses class))
> ,(loop for slot in (sb-mop:class-direct-slots class)
> collect
> (flet ((a (s) (funcall s slot)))
> (append
> (list
> (a #'sb-mop:slot-definition-name)
> :initargs (a #'sb-mop:slot-definition-initargs)
> :initform (a #'sb-mop:slot-definition-initform)
> :type (a #'sb-mop:slot-definition-type)
> :allocation (a #'sb-mop:slot-definition-allocation))
> (mapcan (lambda (x) (list :reader x))
> (sb-mop:slot-definition-readers slot))
> (mapcan (lambda (x) (list :writer x))
> (sb-mop:slot-definition-writers slot)))))))
CL-USER> (let ((x 0))
(defclass myclass () ((a :initform (incf x)))))
#<STANDARD-CLASS MYCLASS>
CL-USER> (get-source (find-class 'myclass))
(DEFCLASS MYCLASS (STANDARD-OBJECT)
((A :INITARGS NIL :INITFORM (INCF X) :TYPE T :ALLOCATION :INSTANCE)))
Hmm...
From: Maciej Katafiasz
Subject: Re: how to add a new slot to an existing class
Date:
Message-ID: <fpcvap$aam$1@news.net.uni-c.dk>
Den Mon, 18 Feb 2008 17:36:23 +0100 skrev Edi Weitz:
> On Mon, 18 Feb 2008 02:52:19 -0800 (PST), szergling
> <···············@gmail.com> wrote:
>
>> (defun get-source (class)
>> `(defclass ,(class-name class) ,(mapcar #'class-name
>> (sb-mop:class-direct-superclasses class))
>> ,(loop for slot in (sb-mop:class-direct-slots class)
>> collect
>> (flet ((a (s) (funcall s slot)))
>> (append
>> (list
>> (a #'sb-mop:slot-definition-name)
>> :initargs (a #'sb-mop:slot-definition-initargs)
>> :initform (a #'sb-mop:slot-definition-initform) :type (a
>> #'sb-mop:slot-definition-type) :allocation (a
>> #'sb-mop:slot-definition-allocation))
>> (mapcan (lambda (x) (list :reader x))
>> (sb-mop:slot-definition-readers slot))
>> (mapcan (lambda (x) (list :writer x))
>> (sb-mop:slot-definition-writers slot)))))))
>
> CL-USER> (let ((x 0))
> (defclass myclass () ((a :initform (incf x)))))
> #<STANDARD-CLASS MYCLASS>
> CL-USER> (get-source (find-class 'myclass)) (DEFCLASS MYCLASS
> (STANDARD-OBJECT)
> ((A :INITARGS NIL :INITFORM (INCF X) :TYPE T :ALLOCATION
> :INSTANCE)))
Using initfunction instead of initform would help here, except that it's
not immediately to me obvious how to stuff them back into the DEFCLASS,
and all my MOP knowledge is currently swapped out by DCT/DFT and image
processing. You could probably hack something up with LET and gensyms,
though that would mean you can't have it literal and would need to whip
up an accompanying macro to do the desired manipulations.
Cheers,
Maciej
On Feb 19, 11:03 am, Maciej Katafiasz <········@gmail.com> wrote:
> Den Mon, 18 Feb 2008 17:36:23 +0100 skrev Edi Weitz:
> >> (defun get-source (class)
> >> `(defclass ,(class-name class) ,(mapcar #'class-name
> >> (sb-mop:class-direct-superclasses class))
> >> ,(loop for slot in (sb-mop:class-direct-slots class)
> >> collect
> >> (flet ((a (s) (funcall s slot)))
> >> (append
> >> (list
> >> (a #'sb-mop:slot-definition-name)
> >> :initargs (a #'sb-mop:slot-definition-initargs)
> >> :initform (a #'sb-mop:slot-definition-initform) :type (a
> >> #'sb-mop:slot-definition-type) :allocation (a
> >> #'sb-mop:slot-definition-allocation))
> >> (mapcan (lambda (x) (list :reader x))
> >> (sb-mop:slot-definition-readers slot))
> >> (mapcan (lambda (x) (list :writer x))
> >> (sb-mop:slot-definition-writers slot)))))))
Apparently :initargs is not completely portable. One may need to
spread that out into individual :initarg like the :reader and :writer
definitions.
> > CL-USER> (let ((x 0))
> > (defclass myclass () ((a :initform (incf x)))))
> > #<STANDARD-CLASS MYCLASS>
> > CL-USER> (get-source (find-class 'myclass)) (DEFCLASS MYCLASS
> > (STANDARD-OBJECT)
> > ((A :INITARGS NIL :INITFORM (INCF X) :TYPE T :ALLOCATION
> > :INSTANCE)))
> Using initfunction instead of initform would help here, except that it's
> not immediately to me obvious how to stuff them back into the DEFCLASS,
That is why we don't need no stinking text for source-code. Try this:
(defun get-source (class)
`(defclass ,(class-name class) ,(mapcar #'class-name
(sb-mop:class-direct-
superclasses class))
,(loop for slot in (sb-mop:class-direct-slots class)
collect
(flet ((a (s) (funcall s slot)))
(append
(list
(a #'sb-mop:slot-definition-name)
:initargs (a #'sb-mop:slot-definition-initargs)
:initform `(funcall ,(a #'sb-mop:slot-definition-
initfunction))
:type (a #'sb-mop:slot-definition-type)
:allocation (a #'sb-mop:slot-definition-allocation))
(mapcan (lambda (x) (list :reader x))
(sb-mop:slot-definition-readers slot))
(mapcan (lambda (x) (list :writer x))
(sb-mop:slot-definition-writers slot)))))))
After trying it out again in the slime REPL, we get back a
presentation object. (It shows up in red)
CL-USER> (get-source (find-class 'myclass))
(DEFCLASS MYCLASS (STANDARD-OBJECT)
((A :INITFORM (FUNCALL #<FUNCTION DEFAULT-A NIL (INCF X)>) :TYPE
T :ALLOCATION
:INSTANCE)))
Putting your point (cursor) at the end of the sexp, and doing C-xC-e,
slime reports a successful class re-definition. :) and :o
;;;; #.(swank:get-repl-result #10r61) ...
Adding slots is a bit harder now. Of course, there's another
algorithm for this that involves the most advanced intelligence known
to the AI world, called the human brain.
`(let ((x 0))
,(get-source (find-class 'myclass)))
Ducks...