Круговые структуры
Прежде всего, в примере, который вы связали, у меня возникает ошибка, когда я пытаюсь создать экземпляр "Алиса", так как его слот :partner имеет значение nil, но объявленный типэто person.Либо вам нужно разрешить для person быть ноль с типом (or null person), либо вы должны обеспечить, чтобы все :partner эффективно указывали на экземпляры person.
Но даже если person может быть nil, могут быть случаи, когда Алиса и Боб оба являются партнерами друг друга;это легко настроить, если человек может быть nil, но в случае, если вы хотите принудительно назначить не ноль человека, вам нужно будет создать его экземпляр следующим образом: сначала вы выделяете оба экземпляра, а затем инициализируете их как обычно:
(flet ((person () (allocate-instance (find-class 'person))))
(let ((alice (person)) (bob (person)))
(setf *mypartner* (initialize-instance alice
:name "Alice"
:address "Regent Street, London"
:phone "555-99999"
:color "blue"
:partner bob
:employed-by *mycompany*))
(setf *myperson* (initialize-instance bob
:name "Bob"
:address "Broadway, NYC"
:phone "555-123456"
:color "orange"
:partner alice
:employed-by *mycompany*))))
В любом случае, если у вас круговые структуры данных, экспорт завершится неудачно с переполнением стека (бесконечная рекурсия).Если вы подозреваете, что у вас могут быть циклические структуры данных, вам нужно хэшировать их с идентификатором при первом посещении и кодировать ссылку на соответствующий идентификатор при следующем посещении.
Например,Возможный способ закодировать эти перекрестные ссылки - добавить "id" ко всем объектам, на которые есть перекрестные ссылки из других источников, и разрешить { "ref" : <id> } вместо фактических значений:
[ {"id" : 0,
"name" : "Alice",
"partner" : { "id" : 1,
"name" : "Bob",
"partner" : { "ref" : 0 }},
{ "ref" : 1 } ]
Это, однако, должно бытьсделано на промежуточном уровне, не жестко закодировано для всех классов.
Самоанализ
Если вы хотите использовать MOP для автоматического сопоставления имен слотов с ключами json, вы можете определить следующие вспомогательные функции:
(defun decompose-class (class)
(mapcar (lambda (slot)
(let* ((slot-name (closer-mop:slot-definition-name slot)))
(list slot-name
(string-downcase slot-name)
(closer-mop:slot-definition-type slot))))
(closer-mop:class-direct-slots (find-class class))))
(defun decompose-value (value)
(loop
for (name str-name type) in (decompose-class (class-of value))
for boundp = (slot-boundp value name)
collect (list name
str-name
type
boundp
(and boundp (slot-value value name)))))
Они зависят от closer-mop и извлекают интересную информацию из класса или данного объекта.Например, вы можете извлечь имена и типы для класса, что полезно для знания того, как кодировать или декодировать значение определенного класса:
(decompose-class 'person)
=> (("name" T)
("address" T)
("phone-number" T)
("favorite-color" T)
("partner" PERSON)
("employed-by" COMPANY))
Аналогично, вы можете захотеть иметь ту же информациюдля объекта вместе с конкретными значениями, связанными со слотом, когда он связан со слотом:
(decompose-value *myperson*)
=> (("name" T T "Bob")
("address" T T "Broadway, NYC")
("phone-number" T T "555-123456")
("favorite-color" T T "orange")
("partner" PERSON T #<PERSON {100E12CB53}>)
("employed-by" COMPANY T #<COMPANY {100D6B3533}>))
Один из возможных способов декодирования объектов заключается в следующем, где "key/values" - это либо необработанный json, либоуже декодированный список ассоциаций в Лиспе, а finder - это функция, которая знает, как получить доступ к key/values, в частности, перекрестные ссылки:
;; finder is responsible for resolving cross-references
(defun decode-as-object (class key/values finder)
(flet ((resolve (name) (funcall finder name key/values)))
(let ((object (allocate-instance (find-class class))))
(dolist (tuple (decompose-class class) (shared-initialize object ()))
(destructuring-bind (name strname class) tuple
(multiple-value-bind (value boundp) (resolve strname)
(when boundp
(setf (slot-value object name)
(if (eql class t)
value
(decode-as-object class value finder))))))))))