LINUX.ORG.RU

[cl] defstruct можно просто print в with-open-file и обратно загрузить, а defclass - не получается


0

0

Структуру в cl можно сохранить в файл для последующего восстановления простым print'ом в with-open-file. Загрузка производится read'ом.

Можно ли без излишних заморочек (не писать свой конвертер, парсер и т.п.) сделать такое же для класса, ибо простой print не выводит необходимую инфу, а выводит указатель.

★★

Там суть в том, что dispatch macro character «#» по букве «S» начинает создание структуры. Сделай какую-нибудь макро-литеру для своих классов и напиши для него функцию, которая будет создавать объект класса из получаемого текста. А для принта в нужном виде переопредели print-object.

Например(тут нужно подключать метаобъектный протокол, как понятно, пакет CLOSER-MOP):

(use-package :closer-mop)

(defclass readable-object () ())

(defmethod print-object ((object readable-object) stream)
  (let ((class (class-of object)))
    (format stream "#L(~s~:[~; ~:*~{~s~^ ~}~])"
            (class-name class)
            (loop for def in (class-slots class)
                  for slot-name = (slot-definition-name def)
                  nconc (list (intern (symbol-name slot-name)
                                      :keyword)
                              (slot-value object slot-name))))))

(defun read-readable-object (in c n)
  (declare (ignore c n))
  (let ((list (read in)))
    (assert (and (listp list)
                 (symbolp (car list)))
            () "Illegal use of #L dispatch character")
    (let* ((class (find-class (car list)))
           (class-slots (class-slots class))
           (instance (allocate-instance class)))
      (loop for (slot-name slot-value) on (rest list) by #'cddr
            for slot = (progn
                         (assert (keywordp slot-name) ()
                           "Illegal slot name designator in #L: ~s~%Must be a keyword."
                           slot-name)
                         (find (symbol-name slot-name)
                               class-slots
                               :test #'string=
                               :key (lambda (def)
                                      (symbol-name
                                        (slot-definition-name def)))))
            if slot do
              (setf (slot-value instance (slot-definition-name slot))
                    slot-value)
            else do
              (error "Class ~s has no slot named ~s"
                     (class-name class) slot-name))
      (initialize-instance instance))))

(set-dispatch-macro-character #\# #\L #'read-readable-object)

;;пример:
(defclass my-class (readable-object)
  ((first-slot :initform 123 :accessor first-slot)
   (second-slot :initform 456 :accessor second-slot)))

(print
  (read-from-string
    (write-to-string
      #L(my-class :second-slot "second slot value"))))
;;напечатает #L(MY-CLASS :FIRST-SLOT 123 :SECOND-SLOT "second slot value")

Love5an
()
Ответ на: комментарий от Love5an

Благодарю, но я, по всей видимости, это делать не буду, ибо cl-store меня удовлетворила полностью.

bk_ ★★
() автор топика
Вы не можете добавлять комментарии в эту тему. Тема перемещена в архив.