Как использовать CLOS для типов, а не для экземпляров?

Question

Представьте себе некоторый базовый класс pgj-model со многими определенными на нем методами, но без слотов. Теперь рассмотрим:

(defclass cat (pgj-model)()) 

(let ((cat (make-instance 'cat))) 
    (ensure-backend cat) 
    (insert cat (obj "name" "Joey" "coat" "tabby"))) 

Если мы хотим, чтобы настроить новый класс cat мы можем специализироваться метод следующим образом:

(defmethod insert ((model cat) (object hash-table)) 
    ;; Do something interesting 
) 

Это все очень хорошо. Но ни pgj-model, ни cat не имеют слотов, они меньше. Это по дизайну, поскольку меня интересуют только их как типы Lisp, на которые можно специализировать методы. Таким образом, кажется, раздражает/запутывает создание экземпляра класса cat везде, где вы хотите назвать такие методы.

Одна идея состоит в том, чтобы сделать:

(defparameter *cat* (make-instance 'cat)) ; There can be only one... 
... 
(insert *cat* (obj "name" "Joey" "coat" "tabby")) 

Другой специализироваться дополнительный метод на всех моих общих функций, как так:

(defmethod insert ((model symbol) object) 
    (insert (make-instance model) object)) 

(insert 'cat (obj "name" "Joey" "coat" "tabby")) 

, который, кажется нормально, но 1) может запутать пользователей, 2) раздувает общую функцию с шаблоном и 3) добавляет некоторые накладные расходы для каждого вызова метода.

Другие предложения?

Answer 1

Один из возможных подходов, но я не советую, потому что это не хорошая практика, чтобы создать свой собственный одноплодный метакласс, так что вы можете специализироваться на allocate-instance до call-next-method в первый раз и кэшировать новый экземпляр для возврата в другое время.

(defclass singleton-class (standard-class) 
    ((instance :initform nil :accessor singleton-class-instance))) 

(defmethod allocate-instance ((class singleton-class) &rest initargs) 
    (declare (ignore initargs)) 
    (with-slots (instance) class 
    (or instance 
     (setf instance (call-next-method))))) 

(defclass pgj-model() 
() 
    (:metaclass singleton-class)) 

(defclass cat (pgj-model) 
() 
    (:metaclass singleton-class)) 

Обратите внимание, что вам необходимо объявить метакласс для каждого класса, он не наследуется.

Аналогичным образом вы можете также специализировать make-instance, чтобы после первого процесса не следовать обычной процедуре инициализации.

Я не занимался синхронизацией, потому что ваш объект без гражданства, но вам может потребоваться обратиться к нему, если вам нужно надежно сохранить единую идентификационную информацию.

И, наконец, это определенно не является хорошей практикой из-за подрыва цели allocate-instance и, следовательно, из make-instance. Согласно спецификации, Лисп реализация могла бы просто составить следующую функцию:

(defun test-singleton-class (class) 
    (eq (make-instance class) 
     (make-instance class))) 

путем оптимизации его, как если бы оно было определено следующим образом:

(defun test-singleton-class (class) 
    ;; possibly inlined make-instance calls 
    nil) 

, не ожидается с этим кодом.

Итак, мой фактический совет заключается в том, чтобы продолжать использовать глобальные переменные или, скорее, глобальные функции чтения, например. не установленный (cat).

Answer 2

Вы можете использовать eql специализаторов для отправки на идентичности символов, а не класс:

(defgeneric insert (thing container)) 

(defmethod insert ((thing (eql 'cat)) (container hash-table)) 
    ...)