I've got a problem for a class. Whenever I access (for reading) any of
it slots, I'd like a variable in the instantiated object to be
automatically updated. This is the class:
(defclass objeto ()
((nombre :initarg :nombre :initform (gensym ""))
(fuerza :initform 0
:initarg :fuerza)
(ultimo-acceso :initform (get-universal-time)
:accessor ultimo-acceso)))
for example, whenever I want to read fuerza I'd like it to update
ultimo-acceso, so the method should be:
(defmethod fuerza ((obj objeto))
(setf (ultimo-acceso obj) (get-universal-time))
(slot-value obj 'fuerza))
and does work. The problem here is when I want to do the same thing
when writing:
(defmethod (setf fuerza) (obj cuanto)
(setf (ultimo-acceso obj) (get-universal-time))
(setf (slot-value obj 'fuerza) cuanto))
CL-USER> (defparameter a (make-instance 'objeto))
A
CL-USER> (setf (fuerza a) 8)
There is no applicable method for the generic function
#<STANDARD-GENERIC-FUNCTION (SETF ULTIMO-ACCESO) (1)>
when called with arguments
(3371376009 8).
[Condition of type SIMPLE-ERROR]
With this example, may I understand that setf cannot be assigned using
methods?
Elsewhere, if I try to assign it using defun:
CL-USER> (fmakunbound '(setf fuerza))
(SETF FUERZA)
CL-USER> (defun (setf fuerza) (obj cuanto)
(setf (slot-value obj 'ultimo-acceso) (get-universal-time))
(setf (slot-value obj 'fuerza) cuanto))
I get the same error.
It seems that methods conflicts in some way with setf definition.
I think that a possible solution might be shadowing slot-value, but I
think this is too much work for doing this simple thing to just one of
my classes. Another thing might be using MOP, but then I'm lose.
I hope somebody could give some ideas.
Javier wrote:
> I've got a problem for a class. Whenever I access (for reading) any of
> it slots, I'd like a variable in the instantiated object to be
> automatically updated. This is the class:
>
> (defclass objeto ()
> ((nombre :initarg :nombre :initform (gensym ""))
> (fuerza :initform 0
> :initarg :fuerza)
> (ultimo-acceso :initform (get-universal-time)
> :accessor ultimo-acceso)))
>
> for example, whenever I want to read fuerza I'd like it to update
> ultimo-acceso, so the method should be:
>
> (defmethod fuerza ((obj objeto))
> (setf (ultimo-acceso obj) (get-universal-time))
> (slot-value obj 'fuerza))
>
> and does work.
Note that you could as well define fuerza as an accessor in the class
objeto, and then write this:
(defmethod fuerza :before ((obj objecto))
(setf (ultimo-acceso obj) (get-universal-time)))
> The problem here is when I want to do the same thing
> when writing:
>
> (defmethod (setf fuerza) (obj cuanto)
> (setf (ultimo-acceso obj) (get-universal-time))
> (setf (slot-value obj 'fuerza) cuanto))
The problem here is that in setf functions, the new value to be set is
passed as the first argument, not as the second. This is to allow setf
functions to work in conjunction with arbitrary combinations of
optional, rest and keyword parameters. So try this:
(defmethod (setf fuerza) :before (cuanto (obj objeto))
(declare (ignore cuanto))
(setf (ultimo-acceso obj) (get-universal-time)))
> I think that a possible solution might be shadowing slot-value, but I
> think this is too much work for doing this simple thing to just one of
> my classes. Another thing might be using MOP, but then I'm lose.
> I hope somebody could give some ideas.
You don't need the MOP for these things. Just define the parameters in
the correct order. ;)
Pascal
--
My website: http://p-cos.net
Common Lisp Document Repository: http://cdr.eurolisp.org
Closer to MOP & ContextL: http://common-lisp.net/project/closer/
Pascal Costanza wrote:
> Note that you could as well define fuerza as an accessor in the class
> objeto, and then write this:
>
> (defmethod fuerza :before ((obj objecto))
> (setf (ultimo-acceso obj) (get-universal-time)))
Oh this is nice, I forget that :before exists. :)
> The problem here is that in setf functions, the new value to be set is
> passed as the first argument, not as the second. This is to allow setf
> functions to work in conjunction with arbitrary combinations of
> optional, rest and keyword parameters. So try this:
>
> (defmethod (setf fuerza) :before (cuanto (obj objeto))
> (declare (ignore cuanto))
> (setf (ultimo-acceso obj) (get-universal-time)))
Thanks, I was confused because setf works in the inverted order.
> > I think that a possible solution might be shadowing slot-value, but I
> > think this is too much work for doing this simple thing to just one of
> > my classes. Another thing might be using MOP, but then I'm lose.
> > I hope somebody could give some ideas.
>
> You don't need the MOP for these things. Just define the parameters in
> the correct order. ;)
Just another question... any idea on how to make this automatically to
happen for any slot of the class without having to manually program it?
And for classes descending from this one? (I think that I then need MOP
for this). I have tried this, but doesn't work (it seems that
slot-value is not implemented as a method):
CL-USER> (defmethod slot-value :before ((obj objeto) slot)
(when (not (equal slot 'ultimo-acceso))
(setf (ultimo-acceso obj) (get-universal-time))))
SLOT-VALUE already names an ordinary function or a macro.
[Condition of type SB-INT:SIMPLE-PROGRAM-ERROR]
Javier wrote:
> Just another question... any idea on how to make this automatically to
> happen for any slot of the class without having to manually program it?
> And for classes descending from this one? (I think that I then need MOP
> for this). I have tried this, but doesn't work (it seems that
> slot-value is not implemented as a method):
>
> CL-USER> (defmethod slot-value :before ((obj objeto) slot)
> (when (not (equal slot 'ultimo-acceso))
> (setf (ultimo-acceso obj) (get-universal-time))))
>
> SLOT-VALUE already names an ordinary function or a macro.
> [Condition of type SB-INT:SIMPLE-PROGRAM-ERROR]
Indeed, slot-value is specified to be a function, not a generic function.
For this to work on all slots, you would need to specify your own
metaclass and define methods on slot-value-using-class, and the likes.
Roughly like this:
(defclass my-class (standard-class)
())
(defmethod validate-superclass (...) ...)
(defmethod slot-value-using-class :before
((class my-class) object slot)
...)
(defmethod (setf slot-value-using-class) :before
(new-value (class my-class) object slot)
...)
(defmethod slot-boundp-using-class :before
((class my-class) object slot)
...)
(defmethod slot-makunbound-using-class :before
((class my-class) object slot)
...)
However, a tricky thing here is that this would trigger on accesses to
'ultimo-acceso as well, which would lead to an infinite loop. You can
avoid that by conditionalizing in the slot-xyz-using-class methods, or
by using different slot definition metaclasses for the different slots
and specializing the third parameters in those methods accordingly
(which are not slot names but slot definition metaobjects).
However, I'd say this is probably overkill, unless you expect this to
happen a lot.
If you indeed want to do this and want to ensure portable code, you
could do worse than use the Closer to MOP compatibility layer, since
different CLOS implementations deviate from the CLOS MOP spec to various
degrees.
Pascal
--
My website: http://p-cos.net
Common Lisp Document Repository: http://cdr.eurolisp.org
Closer to MOP & ContextL: http://common-lisp.net/project/closer/
Pascal Costanza wrote:
> Javier wrote:
>
> > Just another question... any idea on how to make this automatically to
> > happen for any slot of the class without having to manually program it?
> > And for classes descending from this one? (I think that I then need MOP
> > for this). I have tried this, but doesn't work (it seems that
> > slot-value is not implemented as a method):
> >
> > CL-USER> (defmethod slot-value :before ((obj objeto) slot)
> > (when (not (equal slot 'ultimo-acceso))
> > (setf (ultimo-acceso obj) (get-universal-time))))
> >
> > SLOT-VALUE already names an ordinary function or a macro.
> > [Condition of type SB-INT:SIMPLE-PROGRAM-ERROR]
>
> Indeed, slot-value is specified to be a function, not a generic function.
>
> For this to work on all slots, you would need to specify your own
> metaclass and define methods on slot-value-using-class, and the likes.
> Roughly like this:
>
> (defclass my-class (standard-class)
> ())
>
> (defmethod validate-superclass (...) ...)
>
> (defmethod slot-value-using-class :before
> ((class my-class) object slot)
> ...)
>
> (defmethod (setf slot-value-using-class) :before
> (new-value (class my-class) object slot)
> ...)
>
> (defmethod slot-boundp-using-class :before
> ((class my-class) object slot)
> ...)
>
> (defmethod slot-makunbound-using-class :before
> ((class my-class) object slot)
> ...)
>
> However, a tricky thing here is that this would trigger on accesses to
> 'ultimo-acceso as well, which would lead to an infinite loop. You can
> avoid that by conditionalizing in the slot-xyz-using-class methods, or
> by using different slot definition metaclasses for the different slots
> and specializing the third parameters in those methods accordingly
> (which are not slot names but slot definition metaobjects).
>
> However, I'd say this is probably overkill, unless you expect this to
> happen a lot.
>
> If you indeed want to do this and want to ensure portable code, you
> could do worse than use the Closer to MOP compatibility layer, since
> different CLOS implementations deviate from the CLOS MOP spec to various
> degrees.
Thanks for your ideas. I have to have a glance to Closer (but first
learn MOP better).
Meanwhile, I've written this little macro, which not only solves the
problem of having to write write and read methods for every slot, but
also avoids me to type somo repetitive code (like :initarg and
:accessor).
(defgeneric read-wraper (object slot))
(defmethod read-wraper (object slot) nil)
(defgeneric write-wraper (object slot))
(defmethod write-wraper (object slot) nil)
(defmacro defobjeto (name parents slots)
(let ((complete-slots (mapcar
(lambda (slot)
(if (listp slot)
(cond
((not (member :initarg slot))
(append slot `(:initarg ,(car slot))))
((not (member :accessor slot))
(append slot `(:accessor ,(car slot))))
(t slot))
`(,slot :initarg ,slot
:accessor ,slot)))
slots)))
`(progn
(defclass ,name ,parents
,complete-slots)
,@(mapcar (lambda (slot)
(let ((accessor (second (member :accessor slot))))
`(progn
(defmethod ,accessor :before ((obj ,name))
(read-wraper obj ',(car slot)))
(defmethod (setf ,accessor) :before (value (obj ,name))
(declare (ignore value))
(write-wraper obj ',(car slot))))))
complete-slots))))
It could be also possible to add some keywords, like for example
:private, so it does not generate a wrapper nor accessors.
Please give some suggestions if find some bug or bad style.