Сделайте объекты clos пригодными для печати в lisp - PullRequest
Новая
       19

Сделайте объекты clos пригодными для печати в lisp

11 голосов
/ 21 июня 2010

Если вы хотите превратить объекты CLOS в обычный lisp для печати (с возможностью чтения), как вы можете это сделать, не используя ничего, кроме печати и чтения.

1 Ответ

5 голосов
/ 21 июня 2010

Для этого есть две части, по крайней мере, в моем решении, однако вам понадобится эта функция (спасибо ребятам из cl-prevalence за это ( warn LLGPL ) 

(defun get-slots (object)
  ;; thanks to cl-prevalence
  #+openmcl
  (mapcar #'ccl:slot-definition-name
      (#-openmcl-native-threads ccl:class-instance-slots
       #+openmcl-native-threads ccl:class-slots
       (class-of object)))
  #+cmu
  (mapcar #'pcl:slot-definition-name (pcl:class-slots (class-of object)))
  #+sbcl
  (mapcar #'sb-pcl:slot-definition-name (sb-pcl:class-slots (class-of object)))
  #+lispworks
  (mapcar #'hcl:slot-definition-name (hcl:class-slots (class-of object)))
  #+allegro
  (mapcar #'mop:slot-definition-name (mop:class-slots (class-of object)))
  #+sbcl
  (mapcar #'sb-mop:slot-definition-name (sb-mop:class-slots (class-of object)))
  #+clisp
  (mapcar #'clos:slot-definition-name (clos:class-slots (class-of object)))
  #-(or openmcl cmu lispworks allegro sbcl clisp)
  (error "not yet implemented"))

Затем для чтения вам нужно будет запустить этот фрагмент кода, который устанавливает 1/2 синтаксиса, который { type-of-object ((slot-name . slot-value) (slot-name . slot-value) ...) 

(set-macro-character 
     #\{
     #'(lambda (str char)
     (declare (ignore char))
     (let ((list (read-delimited-list #\} str t)))
       (let ((type (first list))
         (list (second list)))
         (let ((class (allocate-instance (find-class type))))
           (loop for i in list do
            (setf (slot-value class (car i)) (cdr i)))
           class)))))

Для печати используйте 

(defmethod print-object ((object standard-object) stream)
  (format stream "{ ~s ~s}" (type-of object)
      (loop for i in (get-slots object)
    collect (cons i (slot-value object i)))))

A *print-readably* настоятельно рекомендуется при использовании всех этих методов. Также обратите внимание, что циклические отношения не проверены

...