~remexre/nrutil

c38f3bd445372a5e5a2cd68cb74314cba198df48 — Nathan Ringo 4 months ago 426ff4e main
prettier printing.
1 files changed, 24 insertions(+), 20 deletions(-)

M main.lisp
M main.lisp => main.lisp +24 -20
@@ 65,26 65,30 @@
  (:documentation "A mixin for printing object graphs READably."))

(defun/typed print-data-class-object-readably ((object data-class) (stream stream)) null
  (let ((class (class-of object)))
    (pprint-logical-block (stream nil)
      (format stream "#.(~s '~s " 'make-instance (class-name class))
      (pprint-indent :block 4 stream)
      (pprint-newline :fill stream)
      (pprint-logical-block (stream nil)
        (iter
          (for slot in (class-slots class))
          (unless (slot-boundp-using-class class object slot)
            (next-iteration))
          (unless (first-time-p)
            (write-char #\Space stream)   
            (pprint-newline :linear stream))
          (format stream "~s " (or (first (slot-definition-initargs slot))
                                   (slot-definition-name slot)))
          (let ((value (slot-value-using-class class object slot)))
            (unless (typep value 'self-evaluating)
              (write-char #\' stream))
            (write value :stream stream))))
      (write-char #\) stream)))
  (let* ((class (class-of object))
         (slots (class-slots class)))
    (flet ((boundp* (slot) (slot-boundp-using-class class object slot)))
      (if (notany #'boundp* slots)
          (format stream "#.(~s '~s)" 'make-instance (class-name class))
          (pprint-logical-block (stream nil)
            (format stream "#.(~s '~s " 'make-instance (class-name class))
            (pprint-indent :block 4 stream)
            (pprint-newline :fill stream)
            (pprint-logical-block (stream nil)
              (iter
                (for slot in slots)
                (unless (boundp* slot)
                  (next-iteration))
                (unless (first-time-p)
                  (write-char #\Space stream)   
                  (pprint-newline :linear stream))
                (format stream "~s " (or (first (slot-definition-initargs slot))
                                         (slot-definition-name slot)))
                (let ((value (slot-value-using-class class object slot)))
                  (unless (typep value 'self-evaluating)
                    (write-char #\' stream))
                  (write value :stream stream))))
            (write-char #\) stream)))))
  nil)

(defgeneric print-object-pretty (object stream)