I'm writing a metaclass that should allow additional initargs in its
slot specifiers. Here is an example of how the metaclass would be used:
(defclass test ()
((b
:accessor test-b
:initarg :b
:bind-to c
:initform 'y)
(c
:accessor test-c
:initform 'x))
(:metaclass bindable-slots-metaclass))
The :BIND-TO initarg is obviously not something standard-slot-definition
accepts, so I define my own slot-definition subclasses:
---
(defclass bindable-slots-metaclass (standard-class)
())
(defmethod validate-superclass ((class bindable-slots-metaclass)
(superclass standard-class))
t)
(defclass bindable-slot-mixin ()
((bind-to :initarg :bind-to)))
(defclass bindable-direct-slot-definition
(standard-direct-slot-definition bindable-slot-mixin)
())
(defclass bindable-effective-slot-definition
(standard-effective-slot-definition bindable-slot-mixin)
())
(defmethod direct-slot-definition-class ((class
bindable-slots-metaclass) &rest initargs)
(find-class 'bindable-direct-slot-definition))
(defmethod effective-slot-definition-class ((class
bindable-slots-metaclass) &rest initargs)
(find-class 'bindable-effective-slot-definition))
(defmethod bindable-slot-bindablep ((slot-definition
bindable-slot-mixin))
(slot-boundp slot-definition 'bind-to))
(defmethod slot-value-using-class ((class bindable-slots-metaclass)
object slot-name)
(let ((slot (find slot-name (class-slots class)
:key #'slot-definition-name)))
(unless slot
(error "Slot named ~S missing from ~S (of class ~S)"
slot-name object (class-name class)))
(if (bindable-slot-bindablep slot)
(break "we got one")
(call-next-method))))
---
So I would expect this code to cause (slot-value (make-instance 'test)
'c) to return the symbol X (which it does) and I'd expect (slot-value
(make-instance 'test) 'b) to enter the debugger, since the B slot
definition has a bound-to slot.
However, the debugger is never entered, and (slot-value (make-instance
'test) 'b) yields the symbol Y with nary a BREAK. Futzing around with
the inspector and breakpoints indicates that in the class object, the
BINDABLE-DIRECT-SLOT-DEFINITION for B has a BIND-TO slot set to the
symbol C (as I'd expect), but by the time BINDABLE-SLOT-BINDABLEP is
called, its argument is an instance of
BINDABLE-EFFECTIVE-SLOT-DEFINITION that has an unbound BIND-TO slot.
I'm new to the MOP and my copy of AMOP isn't available at the moment, so
I apologize if I've missed something basic, but I'm stumped here.
In case it matters, this is on LispWorks 5.0.1 Macintel.
Bill Atkins wrote:
> (defmethod slot-value-using-class ((class bindable-slots-metaclass)
> object slot-name)
> (let ((slot (find slot-name (class-slots class)
> :key #'slot-definition-name)))
> (unless slot
> (error "Slot named ~S missing from ~S (of class ~S)"
> slot-name object (class-name class)))
...you can more easily issue an error here my calling slot-missing, as
defined in ANSI CL.
> (if (bindable-slot-bindablep slot)
> (break "we got one")
> (call-next-method))))
>
> ---
>
> So I would expect this code to cause (slot-value (make-instance 'test)
> 'c) to return the symbol X (which it does) and I'd expect (slot-value
> (make-instance 'test) 'b) to enter the debugger, since the B slot
> definition has a bound-to slot.
>
> However, the debugger is never entered, and (slot-value (make-instance
> 'test) 'b) yields the symbol Y with nary a BREAK. Futzing around with
> the inspector and breakpoints indicates that in the class object, the
> BINDABLE-DIRECT-SLOT-DEFINITION for B has a BIND-TO slot set to the
> symbol C (as I'd expect), but by the time BINDABLE-SLOT-BINDABLEP is
> called, its argument is an instance of
> BINDABLE-EFFECTIVE-SLOT-DEFINITION that has an unbound BIND-TO slot.
>
> I'm new to the MOP and my copy of AMOP isn't available at the moment, so
> I apologize if I've missed something basic, but I'm stumped here.
>
> In case it matters, this is on LispWorks 5.0.1 Macintel.
Are you sure that you're in a package that uses the CLOS package? If
not, you haven't specialized any of the CLOS MOP functions, but just
created new ones that are never called...
Another issue is that LispWorks by default bypasses the slot access
protocol for efficiency reasons. You have to declare that a class should
use the slot access protocol, like this:
(defclass test ()
(...)
(:metaclass bindable-slots-metaclass)
(:optimize-slot-access nil))
Check the LispWorks documentation on its implementation of the CLOS MOP
for more details.
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/
In article <···············@mid.individual.net>,
Pascal Costanza <··@p-cos.net> wrote:
> Bill Atkins wrote:
>
> > (defmethod slot-value-using-class ((class bindable-slots-metaclass)
> > object slot-name)
> > (let ((slot (find slot-name (class-slots class)
> > :key #'slot-definition-name)))
> > (unless slot
> > (error "Slot named ~S missing from ~S (of class ~S)"
> > slot-name object (class-name class)))
>
> ...you can more easily issue an error here my calling slot-missing, as
> defined in ANSI CL.
Thanks.
> Are you sure that you're in a package that uses the CLOS package? If
> not, you haven't specialized any of the CLOS MOP functions, but just
> created new ones that are never called...
Yep. Here's the DEFPACKAGE I left out of the code I pasted:
(defpackage :bindable-slots-metaclass
(:use :cl #+:lispworks :clos #+:sbcl :sb-mop)
(:nicknames :bsm)
(:export #:test))
(in-package :bindable-slots-metaclass)
> Another issue is that LispWorks by default bypasses the slot access
> protocol for efficiency reasons. You have to declare that a class should
> use the slot access protocol, like this:
>
> (defclass test ()
> (...)
> (:metaclass bindable-slots-metaclass)
> (:optimize-slot-access nil))
>
> Check the LispWorks documentation on its implementation of the CLOS MOP
> for more details.
My SLOT-VALUE-USING-CLASS method is definitely being called, with or
without :optimize-slot-access.
Do I have to define a method on COMPUTE-EFFECTIVE-SLOT-DEFINITION and
copy over any custom slots from the direct slot-definition to the
effective slot-definition?
Bill Atkins wrote:
> Do I have to define a method on COMPUTE-EFFECTIVE-SLOT-DEFINITION and
> copy over any custom slots from the direct slot-definition to the
> effective slot-definition?
Yes, that too. ;)
Effective slot definition metaobjects don't see the additional
initialization arguments of direct slot definitions.
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/
On Feb 15, 10:33 am, Pascal Costanza <····@p-cos.net> wrote:
> Bill Atkins wrote:
> > Do I have to define a method on COMPUTE-EFFECTIVE-SLOT-DEFINITION and
> > copy over any custom slots from the direct slot-definition to the
> > effective slot-definition?
>
> Yes, that too. ;)
>
> Effective slot definition metaobjects don't see the additional
> initialization arguments of direct slot definitions.
Thanks. That works now. I guess I assumed the slots would be copied
over when the d-s-d was converted to an e-s-d.