Как переносимо создать класс во время выполнения в Common-Lisp CLOS

#common-lisp #sbcl #clos #ccl

#common-lisp #sbcl #clos #ccl

Вопрос:

Мне нужно создать класс во время выполнения, возможно, не прибегая к eval. Зная, что протокол метакласса не полностью стандартизирован в Common-Lisp, после просмотра протокола метаобъектов Common Lisp Object System, я попробовал следующий код для создания класса, создания его экземпляра и установки значения слота экземпляра в число:

 (defparameter *my-class*
  (make-instance 'standard-class
                 :name 'my-class
                 :direct-slots '((:name x :readers (get-x) :writers ((setf get-x))))))

(defparameter *my-instance* (make-instance *my-class*))

(setf (get-x *my-instance*) 42) ;; => 42
  

К сожалению, этот код корректно работает на SBCL, но не на CCL, где создание класса, похоже, работает, но создание экземпляра (make-instance *my-class*) вызывает следующую ошибку:

 There is no applicable method for the generic function:
  #<STANDARD-GENERIC-FUNCTION INITIALIZE-INSTANCE #x30200002481F>
when called with arguments:
  (#<error printing CONS #x302001A9F6A3>
   [Condition of type CCL:NO-APPLICABLE-METHOD-EXISTS]
  

Я попытался посмотреть на пакет closer-mop, который должен скрывать различия между различными реализациями для протокола meta-object, но я не смог найти ни одной функции или класса, полезных для моей области.

Итак, вопрос: существует ли переносимый способ создания класса и создания его экземпляра во время выполнения с использованием непосредственно уровня метакласса CLOS?

Комментарии:

1. С closer-mop вы можете попробовать обеспечить класс или обеспечить класс с использованием класса .

2. CCL, похоже, работает, если вы также указываете прямые суперклассы :direct-superclasses (list (find-class 'standard-object))

3. Спасибо @jkiiski, проблема в том, что я должен был указать суперкласс. Если вы опубликуете это как ответ, я приму его.

4. Спасибо, @coredump, на самом деле ensure-class не работает с моими параметрами, но работает корректно, если я добавляю прямой суперкласс standard-object (я думал, что это значение по умолчанию, но, возможно, это значение по умолчанию только для defclass ).

5. О, потому что B-> C действительно не сохраняется.

Ответ №1:

Обычно ENSURE-CLASS для создания класса используется. Цель ENSURE-CLASS состоит в том, чтобы быть функциональным эквивалентом DEFCLASS . Минус специальные вещи, зависящие от конкретной реализации DEFCLASS , например, для поддержки функций среды разработки.

Вы можете использовать MAKE-INSTANCE , но, например, он не зарегистрирует класс под своим именем. Он также не будет вызывать никаких дополнительных ENSURE-CLASS-USING-CLASS методов.

Поскольку по умолчанию для метакласса используется standard-class значение, CCL также должен вычислять значение по умолчанию для прямых суперклассов, чего, к сожалению, нет.

Я бы надеялся, что closer-mop исправит эти несовместимости, но я не проверял.

В CCL:

 ? (ensure-class 'my-class
                :direct-slots '((:name x
                                 :readers (get-x)
                                 :writers ((setf get-x))))
                :direct-superclasses (list (find-class 'standard-object)))
#<STANDARD-CLASS MY-CLASS>
? (find-class 'my-class)
#<STANDARD-CLASS MY-CLASS>
? (let ((foo (make-instance 'my-class)))
    (setf (get-x foo) 10)
    (incf (get-x foo) 32)
    (get-x foo))
42
  

LispWorks на самом деле делает это правильно. По умолчанию используется метакласс standard-class , а затем прямой суперкласс standard-object .

 CL-USER 25 > (clos:ensure-class 'foobar
                 :direct-slots '((:name x
                                  :readers (get-x)
                                  :writers ((setf get-x)))))
#<STANDARD-CLASS FOOBAR 4020001713>

CL-USER 26 > (class-direct-superclasses *)
(#<STANDARD-CLASS STANDARD-OBJECT 40E018E313>)
  

Комментарии:

1. Спасибо за ваш полный ответ!

Ответ №2:

Похоже, что CCL требует, чтобы вы также вручную указывали прямые суперклассы.

 (defparameter *my-class*
  (make-instance 'standard-class
                 :name 'my-class
                 :direct-slots '((:name x :readers (get-x) :writers ((setf get-x))))
                 :direct-superclasses (list (find-class 'standard-object))))