0 Replies - 1511 Views - Last Post: 25 June 2010 - 12:24 PM

#1 krzysz00   User is offline

  • D.I.C Head
  • member icon

Reputation: 3
  • View blog
  • Posts: 83
  • Joined: 25-February 09

[Lisp] Simple read-macro for printing CLOS objects readably

Posted 25 June 2010 - 12:24 PM

Description: This readmacro/print-object pair allows you to print CLOS objects in a fashion that allows you to read them back in.
(defun get-slots (object)
  ;; thanks to cl-prevalence (LLGPL (Lisp Lesser GPL) Licensed)
  ;; implementation-dependent function to get all the slots of an object
  (mapcar #'ccl:slot-definition-name
      (#-openmcl-native-threads ccl:class-instance-slots
       #+openmcl-native-threads ccl:class-slots
       (class-of object)))
  (mapcar #'pcl:slot-definition-name (pcl:class-slots (class-of object)))
  (mapcar #'sb-pcl:slot-definition-name (sb-pcl:class-slots (class-of object)))
  (mapcar #'hcl:slot-definition-name (hcl:class-slots (class-of object)))
  (mapcar #'mop:slot-definition-name (mop:class-slots (class-of object)))
  (mapcar #'sb-mop:slot-definition-name (sb-mop:class-slots (class-of object)))
  (mapcar #'clos:slot-definition-name (clos:class-slots (class-of object)))
  #-(or openmcl cmu lispworks allegro sbcl clisp)
  (error "not yet implemented"))

(set-macro-character ;add a new piece of syntax to common lisp
     #{ ;the character in question
     #'(lambda (str char) ; method for reading the character (stream char)
     (declare (ignore char)) ; don't care what the character is
     (let ((list (read-delimited-list #} str t))) ;; read until the next }, recorsively
       (let ((type (first list)) ; type of object
         (list (second list))) ; slots
         (let ((class (allocate-instance (find-class type)))) ; get a class of type `type', but without initializing it
           (loop for i in list do ; loop over the slots
            (setf (slot-value class (car i)) (cdr i))) ; put the slot values in (car) is slot name, (cdr) is value
           class))))) ; return the new object

(defmethod print-object ((object standard-object) stream) ; how do we print standard-objects (this redefines standard methods)
  (format stream "{ ~s ~s}" (type-of object) ; print to stream and the first ~s becomes the type of the object
      (loop for i in (get-slots object) ; loop over the slots in the object
    collect (cons i (slot-value object i))))) ; collect cons cells of the form (name . value)

Is This A Good Question/Topic? 0
  • +

Page 1 of 1