4

I'd like to define methods on class objects, that inherit based upon the class' ancestry in the same way that instances' methods inherit. Is there some way to do this?

Here's what's not working: eql-method specialization. Consider this example:

(defclass animal ()())
(defclass bird (animal)())
(defclass woodpecker (bird)())

(defmethod wings-p ((animal-class (eql (find-class 'animal)))) nil)
(defmethod wings-p ((bird-class   (eql (find-class 'bird))))   t)

Calling (wings-p (find-class 'woodpecker)) generates a no-method-error, and you can see why - class woodpecker obviously isn't eql to any method specializers.

I'd like to define "methods" on bird and animal so that when I call wings-p on (find-class woodpecker), wings-p returns t.

I feel like this is a standard feature of nearly every other OO system, but I can't remember how to do it with CLOS.

Dave Morse
  • 717
  • 9
  • 16
  • 1
    It's not standard in Java, C# or C++, where static methods are the logical equivalent. In these languages, you have to specify the other class, even if it happens to be the base class. – acelent Feb 17 '16 at 23:51

1 Answers1

5

There is indeed no direct inheritance link among objects returned by (find-class 'bird) and (find-class 'woodpecker), exactly as you cannot expect a generic function specialized only on (eql 1) and (eql 2) to produce a result when given a value of 3.

In your case you could derive metaclasses from STANDARD-CLASS. You would need to define methods for VALIDATE-SUPERCLASS too and then you could define your own class having the appropriate :metaclass parameter. For example (find-class 'animal) would return an instance of animal-class. Then, instead of specializing on (eql (find-class 'animal)) you would specialize on animal-class. More precisely:

(defpackage :meta-zoo (:use :closer-common-lisp))
(in-package :meta-zoo)

(defclass animal-class (standard-class) ())
(defclass bird-class (animal-class) ())
(defclass woodpecker-class (bird-class) ())

(defmethod validate-superclass ((class animal-class)
                                (super standard-class)) t)

(defclass animal () () (:metaclass animal-class))
(defclass bird () () (:metaclass bird-class))
(defclass woodpecker () () (:metaclass woodpecker-class))

(defgeneric class-wing-p (class)
  (:method ((a animal-class)) nil)
  (:method ((b bird-class)) t))

(defparameter *woody* (make-instance 'woodpecker))

(class-of *woody*)
;; => #<woodpecker-class woodpecker>

(class-wing-p (class-of *woody*))
;; => t
coredump
  • 37,664
  • 5
  • 43
  • 77