How do I define a CLOS method that specializes on a class (i.e., instead
of on instances of that class) and that can be inherited by subclasses?
I can approximate the idea of a class method with:
(defmethod foo ((class (eql (find-class 'bar))))
'the-thing-is-done)
but this won't work if I want to call FOO on a subclass of class BAR.
In other words, given:
(defclass bar ()
())
(defclass baz (bar)
())
I want (foo (find-class 'baz)) to call the method above instead of
failing to find an applicable method.
Bill Atkins wrote:
> How do I define a CLOS method that specializes on a class (i.e., instead
By specializing the parameter on the class of that class, in other
words its metaclass.
> of on instances of that class) and that can be inherited by subclasses?
Subclasses of a class are all instances of the same meta-class, so that
method will take them all.
For example, MAKE-INSTANCE is such a method. Works on all classes,
right?
> I can approximate the idea of a class method with:
>
> (defmethod foo ((class (eql (find-class 'bar))))
> 'the-thing-is-done)
>
> but this won't work if I want to call FOO on a subclass of class BAR.
I'd just give up here and use some hack involving representative
instances.
Of course what you want is not EQL, but SUBTYPEP: the argument is
suitable if it's a subtype of bar. Problem is that you can't specialize
using SUBTYPEP. You get EQL and that is that.
Maybe the MOP can be used to hack SUBTYPEP specialization.
Or you could just hack your own interfaces, resembling DEFGENERIC and
DEFMETHOD which do this SUBTYPEP specialization on a single argument.
How about this crap, which doesn't even support multiple inheritance?
(defparameter *subtype-method-hash* (make-hash-table :test #'eq))
(defstruct subtype-generic-function
(class t)
(handler nil)
(children))
(defun find-subtype-generic-function (name)
(gethash name *subtype-method-hash*))
(defun ensure-subtype-generic-function (name)
(let ((gf (find-subtype-generic-function name)))
(if gf gf
(progn
(eval `(defun ,name (class &rest args)
(apply #'call-subtype-method ',name class args)))
(setf (gethash name *subtype-method-hash*)
(make-subtype-generic-function))))))
(defun add-subtype-handler (gf class handler)
(if (eq class (subtype-generic-function-class gf))
(progn
(setf (subtype-generic-function-handler gf) handler)
(values))
(progn
(loop for child-cons = (subtype-generic-function-children gf)
then (cdr child-cons)
for child = (car child-cons)
until (null child)
when (subtypep class (subtype-generic-function-class
child))
do
(add-subtype-handler child class handler)
(return-from add-subtype-handler (values))
when (subtypep (subtype-generic-function-class child)
class)
do
(setf (car child-cons)
(make-subtype-generic-function :class class
:handler handler
:children (list
child)))
(return-from add-subtype-handler (values)))
(push (make-subtype-generic-function :class class
:handler handler
:children nil)
(subtype-generic-function-children gf))
(values))))
(defun invoke-subtype-handler (gf class &rest args)
(if (eq class (subtype-generic-function-class gf))
(apply (subtype-generic-function-handler gf) class args)
(dolist (child (subtype-generic-function-children gf)
(error "no subtype method for ~s ~s combination."
gf class))
(if (subtypep class (subtype-generic-function-class child))
(return (apply #'invoke-subtype-handler child class args))))))
(defun add-subtype-method (name class handler)
(let ((gf (ensure-subtype-generic-function name)))
(add-subtype-handler gf class handler)))
(defun call-subtype-method (name class &rest args)
(let ((gf (find-subtype-generic-function name)))
(if gf
(apply #'invoke-subtype-handler gf class args)
(error "no subtype generic function ~s." name))))
(defmacro define-subtype-generic (name)
(ensure-subtype-generic-function name))
(defmacro define-subtype-method (name ((special-arg class) &rest args)
&body body)
(let ((gf-sym (gensym "GF-")))
`(progn
(let ((,gf-sym (ensure-subtype-generic-function ',name)))
(add-subtype-method ',name ',class (lambda (,special-arg
,@args)
,@body))
,gf-sym))))
Test:
[1]> (load "subtype-specialization.lisp")
;; Loading file subtype-specialization.lisp ...
;; Loaded file subtype-specialization.lisp
T
[2]> (define-subtype-method foo ((i integer) x y) (format t "INTEGER ~s
~s ~s~%" i x y))
#S(SUBTYPE-GENERIC-FUNCTION :CLASS T :HANDLER NIL
:CHILDREN
(#S(SUBTYPE-GENERIC-FUNCTION :CLASS INTEGER
:HANDLER
#<FUNCTION :LAMBDA (I X Y) (FORMAT T "INTEGER ~s ~s ~s~%" I X
Y)>
:CHILDREN NIL)))
[3]> (define-subtype-method foo ((i real) x y) (format t "REAL ~s ~s
~s~%" i x y))
#S(SUBTYPE-GENERIC-FUNCTION :CLASS T :HANDLER NIL
:CHILDREN
(#S(SUBTYPE-GENERIC-FUNCTION :CLASS REAL
:HANDLER #<FUNCTION :LAMBDA (I X Y) (FORMAT T "REAL ~s ~s ~s~%"
I X Y)>
:CHILDREN
(#S(SUBTYPE-GENERIC-FUNCTION :CLASS INTEGER
:HANDLER
#<FUNCTION :LAMBDA (I X Y) (FORMAT T "INTEGER ~s ~s ~s~%" I
X Y)>
:CHILDREN NIL)))))
[4]> (foo 'real 3 4)
REAL REAL 3 4
NIL
[5]> (foo 'integer 3 4)
INTEGER INTEGER 3 4
NIL
Bleah ... It should be illegal to crank out working code as fast as
you can type.
Kaz Kylheku wrote:
> Bleah ... It should be illegal to crank out working code as fast as
> you can type.
Phew! I narrowly avoided indictment there.
This version of INVOKE-SUBTYPE-HANDLER works slightly better. Now, for
instance, a method for the RATIONAL class actually accepts an INTEGER
argument. :)
(defun invoke-subtype-handler (gf class &rest args)
(when (eq class (subtype-generic-function-class gf))
(return-from invoke-subtype-handler
(apply (subtype-generic-function-handler gf) class
args)))
(dolist (child (subtype-generic-function-children gf))
(if (subtypep class (subtype-generic-function-class child))
(return-from invoke-subtype-handler
(apply #'invoke-subtype-handler child class args))))
(when (subtypep class (subtype-generic-function-class gf))
(return-from invoke-subtype-handler
(apply (subtype-generic-function-handler gf) class
args)))
(error "no subtype method for ~s ~s combination." gf class))
Of course this whole crap should work with classes, rather than class
symbols, haha.
Bill Atkins wrote:
> How do I define a CLOS method that specializes on a class (i.e., instead
> of on instances of that class) and that can be inherited by subclasses?
>
> I can approximate the idea of a class method with:
>
> (defmethod foo ((class (eql (find-class 'bar))))
> 'the-thing-is-done)
>
> but this won't work if I want to call FOO on a subclass of class BAR.
>
> In other words, given:
>
> (defclass bar ()
> ())
>
> (defclass baz (bar)
> ())
>
> I want (foo (find-class 'baz)) to call the method above instead of
> failing to find an applicable method.
Yikes, time for the HSQ*.
Don't worry, the Question Slaves will be along shortly to Just Answer
the Question. Not sure what they can offer. bar and baz are both
instances of standard-class, so I do not see how GF dispatch can work
for you unless you are serious about this and want to start doing some
moppery and create a subclass of standard-class of which both bar and
baz will be instances. But you would have to justify such shenanigans
(if only to yourself) with a good answer to the HSQ.
kt
* The hardware store question: what do you need this for? k
--
The Dalai Lama gets the same crap all the time.
-- Kenny Tilton on c.l.l when accused of immodesty
Bill Atkins wrote:
> How do I define a CLOS method that specializes on a class (i.e., instead
> of on instances of that class) and that can be inherited by subclasses?
>
> I can approximate the idea of a class method with:
>
> (defmethod foo ((class (eql (find-class 'bar))))
> 'the-thing-is-done)
>
> but this won't work if I want to call FOO on a subclass of class BAR.
>
> In other words, given:
>
> (defclass bar ()
> ())
>
> (defclass baz (bar)
> ())
>
> I want (foo (find-class 'baz)) to call the method above instead of
> failing to find an applicable method.
If you want to specialize a method on a class instead of instances of
that class, you still specialize it as before. The trick is not to
change the specialization but to use an instance that represents the
whole class. The CLOS MOP provides a function class-prototype that gives
you such a representation of the class.
So do this:
(defmethod ((class bar)) 'the-thing-is-done)
And call it like that:
(foo (class-prototype (find-class 'baz)))
The catch is that class-prototype is not part of ANSI Common Lisp.
However, defining it yourself is relatively straightforward:
(defvar *class-prototypes* (make-hash-table))
(defun class-prototype (class)
(or (gethash class *class-prototypes*)
(setf (gethash class *class-prototypes*)
(allocate-instance class))))
The CLOS MOP doesn't say anything about whether a class prototype is
ever initialized or not. That's why using allocate-instance instead of
make-instance here is sufficient. The class prototype is indeed only to
be used for method dispatch, never as a proper instance of its own.
Of course, Ken's question still applies: What is the actual goal behind
your question? Maybe there is a simpler solution for what you actually
want to achieve.
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:
> If you want to specialize a method on a class instead of instances of
> that class, you still specialize it as before. The trick is not to
> change the specialization but to use an instance that represents the
> whole class. The CLOS MOP provides a function class-prototype that gives
> you such a representation of the class.
>
> So do this:
>
> (defmethod ((class bar)) 'the-thing-is-done)
>
> And call it like that:
>
> (foo (class-prototype (find-class 'baz)))
>
> The catch is that class-prototype is not part of ANSI Common Lisp.
> However, defining it yourself is relatively straightforward:
>
> (defvar *class-prototypes* (make-hash-table))
>
> (defun class-prototype (class)
> (or (gethash class *class-prototypes*)
> (setf (gethash class *class-prototypes*)
> (allocate-instance class))))
>
> The CLOS MOP doesn't say anything about whether a class prototype is
> ever initialized or not. That's why using allocate-instance instead of
> make-instance here is sufficient. The class prototype is indeed only to
> be used for method dispatch, never as a proper instance of its own.
>
>
> Of course, Ken's question still applies: What is the actual goal behind
> your question? Maybe there is a simpler solution for what you actually
> want to achieve.
Yes, I realized that when I couldn't come up with any better names than
FOO, BAR, and BAZ that I probably wasn't thinking of a very concrete
example. :)
This question occurred to me earlier in the day, when I think I actually
wanted it for something, but by the time I posted I couldn't remember
what I had in mind.
Thanks for the help, though. CLASS-PROTOTYPE seems like it will do
exactly what I need, if I ever remember why I needed it. ;)