Есть ли способ получить доступ к слотам в списке суперклассов в CLOS?

Question

Есть ли способ получить доступ к слотам суперклассов в CLOS?

Например, в Objective C I можно выполнить

- (void) frob {
[super frob]
}

Это отправляет сообщение (единственному) суперклассу frob.

Изучение документации CLOS предполагает, что DEFCLASS объединяет всю информацию суперкласса о создании класса, и, таким образом, эта способность связываться с суперклассом теряется. Это правильно?

редактировать:

Сценарий несколько необычный:

Данные занятия

(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))

Как получить метод, скажем, BEHAVIOR-TYPES или же GET-BEHAVIOR что при вызове с объектом типа horse, возвращает '(:eat :sleep :drink :buck :gambol :neigh), То есть наследование через слот "добавляет" к initform, а не заменяет его.

Простое решение состоит в том, чтобы вместо присвоения данных классу иметь общий метод, например, так:

(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)))

Однако это решение перемещает данные в defgeneric а не класс, к которому он принадлежит. Таким образом, мотивация вопроса возникла из этого.

Во всяком случае, вопрос в том виде, в котором он задавался, отражал неправильное понимание дизайна CLOS. Невозможно, как просили и в рамках обычной структуры, выполнить эту задачу. Однако ниже приведены два отдельных подхода с использованием СС для решения поставленной мной задачи.

Answer 1

Название вашего вопроса звучит так, будто вы спрашиваете о том, как получить доступ к слотам, но код, который вы показываете, больше похож на вызов методов, которые были специализированы для суперкласса. Если вы ищете последнее, вы должны взглянуть на call-next-method, а также 7.6 Общие функции и методы из HyperSpec.

Вызов "методов суперкласса"

В CLOS методы не принадлежат классам, как в некоторых других языках. Вместо этого есть общие функции, для которых определены специализированные методы. Для заданного списка аргументов может быть применимо несколько методов, но только один является наиболее конкретным. Вы можете вызвать следующий наиболее конкретный метод с call-next-method, В следующем тексте есть класс FOO и подкласс BAR и универсальная функция FROB который имеет методы, специализированные для FOO а также BAR, В методе, специализированном для BAR есть вызов call-next-method который в этом случае вызывает метод, специализированный для 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

Моделирование с помощью комбинаций методов

Вы можете использовать комбинации методов, чтобы объединить результаты методов, которые применимы к списку аргументов. Например, вы можете определить метод a с комбинацией методов list это значит, когда вы звоните (a thing) все методы на a Применимые для аргумента называются, а их результаты объединяются в список. Если вы дадите своим слотам в разных классах разные имена и специализируете методы на a читая эти значения, вы можете имитировать то, что ищете. Это не мешает вам также использовать традиционный ридер, который также обращается к слоту (например, get-a в следующем примере). Следующий код показывает пример:

(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

Использование СС

Этот пост 1998 года об архивах Allegro CL стоит прочитать. Похоже, автор ищет что-то похожее на то, что вы ищете.

Мне нужно определить поведение наследования, которое объединяет строковые значения superclass-initforms с локальными слотами initforms. Например

(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"

Я не нашел стандартную опцию в слот-описании defclass для этого. Я хотел бы определить объединенную комбинацию для каждого мета-класса 'user-class'.

Ответ (Хейко Киршке, не я, но также вижу этот ответ от Джона Уайта с подобным подходом), определяет новый тип класса:

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

и специализируется clos:compute-effective-slot-definition чтобы предоставить initform, которая вычисляется из определений слотов класса и его суперкласса (ов):

(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))

Тогда это используется так:

(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"

Это касается функциональности MOP, которая не указана в спецификации, поэтому вам, возможно, придется адаптировать ее для вашей конкретной реализации. Есть несколько пакетов уровня совместимости MOP, которые могут вам помочь.

Answer 2

В CLOS нет такого понятия, как слот экземпляра суперкласса.

Если вы создаете экземпляр, у него есть все слоты. Все слоты из класса и его суперклассы.

Если у класса есть слот FOO и некоторые суперклассы также имеют слоты с именем FOOвсе они объединены в один слот. Каждый экземпляр этого класса CLOS будет иметь этот слот.

Тем не менее, вам нужно быть более осторожным с вашей формулировкой. Суперклассы сами являются объектами, и у них есть сами слоты. Но это не имеет никакого отношения к экземпляру, имеющему локальные слоты и имеющему суперклассы со слотами экземпляра. Последний не существует в CLOS.

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

Выше это суперкласс с двумя слотами.

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

Выше класс с двумя локальными и одним унаследованным слотом. Слот b на самом деле объединены из этого класса и из суперкласса.

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

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

Выше показано, что экземпляр имеет три слота, и все могут быть доступны напрямую. Даже слот `a, который был определен в суперклассе.

Если мы посмотрим на фактический суперкласс как на сам экземпляр, мы увидим его слоты:

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

Answer 3

Это действительно очень по-настоящему. Я надеюсь, что кто-то вмешается и исправит это, хотя это должно проиллюстрировать идею:

(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. Я вижу, что функция, которая вычисляет список определений слотов в SBCL, находится в std-class.lisp, std-compute-slots, Так что это не то, что MOP определяет каким-то образом... Но это было бы очень полезно здесь.