Is there a way to access slots in the superclass list in CLOS?

Question

Is there a way to access slots of superclasses in CLOS?

E.g., in Objective C I can perform

- (void) frob {
[super frob]
}

This sends a message to the (sole) superclass of frob.

Perusing the CLOS documentation suggests that DEFCLASS merges all superclass information on class creation and thus this ability to communicate with the superclass is lost. Is this correct?

edit:

The scenario is somewhat unusual:

Given classes

(defclass animal ()
  ((behavior-types
     :initform '(:eat :sleep :drink)
     :reader behavior-types)))

(defclass cow (animal)  
  ((behavior-types
     :initform '(:moo :make-milk)
     :reader behavior-types))

(defclass horse
  ((behavior-types 
     :initform '(:buck :gambol :neigh)
     :reader behavior-types))

How to have a method, say, BEHAVIOR-TYPES or GET-BEHAVIOR that, when called with an object of type horse, returns '(:eat :sleep :drink :buck :gambol :neigh). That is to say, inheritance via a slot "adds" to the initform rather than replaces it.

An easy solution is, rather than to assign the data to the class, to have a generic method like so:

(defgeneric behavior-types (obj))

(defmethod behavior-types ((obj animal)) nil)

(defmethod behavior-types :around ((obj animal))
  (append '(:eat :sleep :drink)
          (call-next-method obj)))


(defmethod behavior-types :around ((obj horse))
  (append '(:gambol :neigh :buck)
          (call-next-method obj)))

However, this solution moves the data into the defgeneric rather than the class, where it properly belongs. So the motivation for the question came forth out of this.

At any rate - the question as asked reflected a misunderstanding of CLOS's design. It is not possible, as asked and within the normal framework, to perform this task. However, two separate approaches are given below using the MOP to solve the problem I posed.

Answer 1

The title of your question makes it sound like you're asking about how to access slots, but the code you show seems more like it's about calling methods that have been specialized for the superclass. If it's the latter that you're looking for, you should take a look at call-next-method, as well as 7.6 Generic Functions and Methods from the HyperSpec.

Calling “superclass methods”

In CLOS, methods don't belong to classes like they do in some other languages. Instead, there are generic functions on which specialized methods are defined. For a given argument list, a number of methods may be applicable, but only one is most specific. You can call the next most specific method with call-next-method. In the following transcript, there's a class FOO and a subclass BAR, and a generic function FROB which has methods specialized for FOO and BAR. In the method specialized for BAR, there's a call to call-next-method which, in this case, calls the method specialized for FOO.

CL-USER> (defclass foo () ())
;=> #<STANDARD-CLASS FOO>
CL-USER> (defclass bar (foo) ())
;=> #<STANDARD-CLASS BAR>
CL-USER> (defgeneric frob (thing))
;=> #<STANDARD-GENERIC-FUNCTION FROB (0)>
CL-USER> (defmethod frob ((foo foo))
           (print 'frobbing-a-foo))
;=> #<STANDARD-METHOD FROB (FOO) {1002DA1E11}>
CL-USER> (defmethod frob ((bar bar))
           (call-next-method)
           (print 'frobbing-a-bar))
;=> #<STANDARD-METHOD FROB (BAR) {1002AA9C91}>
CL-USER> (frob (make-instance 'bar))

FROBBING-A-FOO 
FROBBING-A-BAR 
;=> FROBBING-A-BAR

Simulating it with method combinations

You can use method combinations to combine the results of the methods that are applicable to a list of arguments. For instance, you can define a method a with the method combination list that means when you call (a thing), all the methods on a applicable for the argument are called, and their results are combined into a list. If you give your slots in the different classes different names, and specialize methods on a that read those values, you can simulate the sort of thing you're looking for. This doens't prevent you from also using a traditional reader that accesses the slot, as well (e.g., get-a in the following example). The following code shows an example:

(defgeneric a (thing)
  (:method-combination list))

(defclass animal ()
  ((animal-a :initform 'a :reader get-a)))

(defmethod a list ((thing animal))
  (slot-value thing 'animal-a))

(defclass dog (animal)
  ((dog-a :initform 'b :reader get-a)))

(defmethod a list ((thing dog))
  (slot-value thing 'dog-a))

(a (make-instance 'dog))

(get-a (make-instance 'animal))
;=> A

(get-a (make-instance 'dog))
;=> B

Using the MOP

This post from 1998 on Allegro CL archives is worth a read. It sounds like the author is looking for something similar to what you're looking for.

I need to define an inheritance behavior that concatenates string-values of superclass-initforms with local slot initforms. E.g.

(defclass super()
  ((f :accessor f :initform "head")) (:metaclass user-class))

(defclass sub(super)
  ((f :accessor f :initform "tail")) (:metaclass user-class))

I'd like to get the following:

(f(make-instance'sub)) -> "head tail"

I didn't find a standard option in defclass slot-descriptions for this. I'd like to define the concatenate combination for each meta-class 'user-class'.

The response (by Heiko Kirschke, not me, but also see this response from Jon White with a similar approach), defines a new type of class:

(defclass user-class (standard-class) ())

and specializes clos:compute-effective-slot-definition to provide an initform that's computed from the slot definitions of the class and its superclass(es):

(defmethod clos:compute-effective-slot-definition
    ((the-class user-class) slot-name
     ;; The order of the direct slots in direct-slot-definitions may
     ;; be reversed in other LISPs (this is code written & tested with
     ;; ACL 4.3):
     direct-slot-definitions)
  (let ((slot-definition (call-next-method))
    (new-initform nil))
    (loop for slot in direct-slot-definitions
    as initform = (clos:slot-definition-initform slot)
    when (stringp initform)
    do
      ;; Collecting the result string could be done perhaps more
      ;; elegant:
      (setf new-initform (if new-initform
                 (concatenate 'string initform " "
                          new-initform)
                   initform)))
    (when new-initform
      ;; Since at (call-next-method) both the initform and
      ;; initfunction of the effective-slot had been set, both must be
      ;; changed here, too:
      (setf (slot-value slot-definition 'clos::initform) new-initform)
      (setf (slot-value slot-definition 'clos::initfunction)
    (constantly new-initform)))
    slot-definition))

Then it's used like this:

(defclass super ()
  ((f :accessor f :initform "head"))
  (:metaclass user-class))

(defclass sub(super)
  ((f :accessor f :initform "tail"))
  (:metaclass user-class))

(f (make-instance 'sub))
==> "head tail"

This is getting into MOP functionality that's not specified by the spec, so you might have to adapt it for your particular implementation. There are some MOP compatibility layer packages out there that might be able to help you out, though.

Answer 2

This is really, really hasckish. I hope someone will step in and fix it, though it should illustrate the idea:

(defclass agent () ((behaviour :initform do-nothing :accessor behaviour-of)))

(defclass walk-agent (agent) ((behaviour :initform and-walk)))

(defclass talk-agent (walk-agent) ((behaviour :initform and-talk)))

(defmethod sb-mop:compute-effective-slot-definition
           :after (class (name (eql 'behaviour)) sdlotds)
  (setf *slot-def* 
        (loop
           :for slot :in sdlotds :do
           (format t "~&slot: ~s" (sb-mop:slot-definition-initform slot))
           :collect (sb-mop:slot-definition-initform slot))))

(defmethod initialize-instance :before ((instance agent) &rest keyargs)
  (declare (ignore keyargs))
  (let (*slot-def*)
    (declare (special *slot-def*))
    (sb-mop:compute-slots (class-of instance))
    (setf (behaviour-of instance) *slot-def*)))

;; (behaviour-of (make-instance 'talk-agent))

;; slot: AND-TALK
;; slot: AND-WALK
;; slot: DO-NOTHING
;; slot: AND-TALK
;; slot: AND-WALK
;; slot: DO-NOTHING
;; (AND-TALK AND-WALK DO-NOTHING)

PS. I see that the function that computes the list of slots definitions in SBCL is in std-class.lisp, std-compute-slots. So it isn't something that MOP defines in some way... But this one would be really helpful here.

Answer 3

There is no such concept as the instance slot of a superclass in CLOS.

If you create an instance, it has all slots. All slots from the class and its superclasses.

If a class has a slot FOO and some superclasses have also slots named FOO, all those are merged into one slot. Each instance of that CLOS class will have that slot.

Still you need to be more careful with your wording. Superclasses are objects themselves and they have slots themselves. But this has nothing to do with an instance having local slots and having superclasses with instance slots. The latter does not exist in CLOS.

CL-USER 18 > (defclass bar () (a b))
#<STANDARD-CLASS BAR 413039BD0B>

Above is then a superclass with two slots.

CL-USER 19 > (defclass foo (bar) (b c))
#<STANDARD-CLASS FOO 4130387C93>

Above is a class with two local and one inherited slot. The slot b is actually merged from this class and from the superclass.

CL-USER 20 > (describe (make-instance 'foo))

#<FOO 402000951B> is a FOO
B      #<unbound slot>
C      #<unbound slot>
A      #<unbound slot>

Above shows that the instance has three slots and all can be directly accessed. Even the slot `a, which was defined in the superclass.

If we look at the actual superclass as an instance itself, we see its slots:

CL-USER 21 > (describe (find-class 'bar))

#<STANDARD-CLASS BAR 413039BD0B> is a STANDARD-CLASS
NAME                         BAR
DEFAULT-INITARGS             NIL
DIRECT-DEFAULT-INITARGS      NIL
DIRECT-SLOTS                 (#<STANDARD-DIRECT-SLOT-DEFINITION A 4020005A23> #<STANDARD-DIRECT-SLOT-DEFINITION B 4020005A93>)
DIRECT-SUBCLASSES            (#<STANDARD-CLASS FOO 4130387C93>)
DIRECT-SUPERCLASSES          (#<STANDARD-CLASS STANDARD-OBJECT 40F017732B>)
PRECEDENCE-LIST              (#<STANDARD-CLASS BAR 413039BD0B> #<STANDARD-CLASS STANDARD-OBJECT 40F017732B> #<BUILT-IN-CLASS T 40F00394DB>)
PROTOTYPE                    NIL
DIRECT-METHODS               NIL
WRAPPER                      #(1539 (A B) NIL #<STANDARD-CLASS BAR 413039BD0B> (#<STANDARD-EFFECTIVE-SLOT-DEFINITION A 4020005AFB> #<STANDARD-EFFECTIVE-SLOT-DEFINITION B 4020005B63>) 2)
LOCK                         #<MP::SHARING-LOCK "Lock for (STANDARD-CLASS BAR)" Unlocked 41303AD4E3>
DOCUMENTATION-SLOT           NIL
PLIST                        (CLOS::COPYABLE-INSTANCE #<BAR 402000638B>)
POTENTIAL-INITARGS           0
MAKE-INSTANCE-FLAGS          509
OTHER-LOCK                   #<MP:LOCK "Lock for (OTHER STANDARD-CLASS BAR)" Unlocked 41303AD553>
REINITIALIZE-INITARGS        0
REDEFINE-INITARGS            0
DEPENDENTS                   NIL