We’ve come to the end of pretty-printing, at least for the moment, and continue our walk through the less commonly used parts of Common Lisp with the print-object generic function.  We’ve mentioned this function briefly in passing a few times already, a good example would be this early post.

The programmer must not call the print-object method directly, but that doesn’t mean it isn’t interesting to the programmer.  The way the programmer typically interacts with this method is by specializing it on a new class or structure.  The example post linked to above does that, for the doubly-linked list structures I was reviewing at the time.

The difficulty with the doubly-linked list structure was that, if you created one with two or more elements in it, and found yourself trying to display it to the user, the internal circularity of the structure led to an infinite loop during output, which was irritating during development.  By specializing print-object on the structure, I was able to print out the contents of the list without the internal circularity being a problem.

The version of the function that I used there isn’t really complete, it’s just something short for debugging purposes.  Properly, print-object should acknowledge the special variables that control printing, and format the output appropriately.  The relevant variables are:

• *print-readably* which should produce output that would recreate the list if presented to the Lisp reader.  Look at the earlier example for make-load-form.
• *print-escape* of which *print-readably* is a superset, should also produce output suitable for reading into the Lisp reader.
• *print-pretty* which should produce output intended to be more easily understood by humans, typically by the introduction of additional formatting whitespace.
• *print-length* which indicates how many elements in a sequence should be printed before the rest of the sequence is elided.
• *print-level* which is handled by the implementation if the print-object method obeys a simple restriction, that nested structures are handled by passing the sub-elements to write or similar output functions, not descended internally in the function itself.  This allows the printer to keep track of the level of nesting that is being printed.
• *print-circle* which indicates that the calling context wants circularity detection to be performed, and if that requires special behaviour in the print-object method, it has to be coded to handle that case.
• *print-radix* and *print-base* which affect the printing of rational numbers.  The programmer is unlikely to have to take special action on these variables, and can probably let them be passed down to the function responsible for printing the numeric values.
• *print-case* which affects how symbol names are output.  Also unlikely to require special action by the programmer.
• *print-gensym* which affects the output of uninterned symbol names, such as those returned by gensym.  Once more, the programmer is unlikely to have to write special code to respond to the value of this variable in print-object.
• *print-array* which determines whether non-string arrays should have their contents printed, or whether a short specifier should be output instead.

The print-object generic function should return a single value, the object passed in for printing.  That is also something that was not correctly done in the earlier example.

Finally, now that we’ve covered *print-circle*, I should point out that that is another way to avoid the circularity problem printing out doubly-linked lists.  Rather than defining a print-object method, I could have done my coding in an environment where *print-circle* is non-nil.  In that case, the circularity detection allows the printer to avoid the infinite loop, and doubly-linked lists can be printed:

CL-USER> (let ((dl (dl-list:make-dl-list)))
           (dl-list:push-front dl 10) 
           (dl-list:push-front dl 20) 
           dl)
#S(DL-LIST::DL-LIST
   :FIRST-NODE #1=#S(DL-LIST::DL-NODE
                     :VALUE 20
                     :NEXT-NODE #2=#S(DL-LIST::DL-NODE
                                      :VALUE 10
                                      :NEXT-NODE NIL
                                      :PREV-NODE #1#)
                     :PREV-NODE NIL)
   :LAST-NODE #2#)

Continuing through the commands related to pretty-printing, next is pprint-tab.  This function is used to move the effective cursor to a certain tab position, as if by the ~T argument to format.  As the use of format is not recommended inside a pprint-logical-block when *print-pretty* is non-nil, this function allows the effect of tabbing without the use of format.  Note that this function has no effect if *print-pretty* is nil.

The pprint-tab function takes a “kind” argument that determines how the tabs are calculated.

If kind is :line, the tabbing is set based on the start of the line, as if by a simple ~T argument to format.

If kind is :section, the tabbing is set based on the start of the enclosing section.

If kind is :line-relative, the tabbing is set based on the start of the line, but using relative tabulation, as defined by ~@T in format.

If kind is :section-relative, the tabbing is set based on the start of the enclosing section, again using relative tabulation as above.

Next, we come to pprint-pop.  Like most of the pretty-printing functions we’ve described recently, this is intended to be used inside a block defined by pprint-logical-block.  In fact, this local macro cannot be used outside of one of those blocks, and may not even be bound.

The pprint-pop local macro is used to remove the next object from the list being printed, and return it to the caller.  It is important to use pprint-pop rather than a bare pop, because of the behaviour which we previously mentioned, that a pprint-logical-block may be executed in its entirety more than once, in order to do circularity detection.  Calling the pop macro would lead to unpredictable behaviour, as the list that the pprint-logical-block is processing would be modified between the two passes.

Continuing our discussion of pretty-printing, we arrive at pprint-newline.  This is another function that is used inside the environment set up within the context of pprint-logical-block.  The pprint-newline function takes a ‘kind’ argument that can be one of four possible keyword values.

If kind is :linear, a newline will be printed only if the entire output of the section cannot fit on a single line.  In that case, all such linear-mode newlines will be output.  In the typical usage, this means you either print all objects on one line, or each object on its own line.  Compare this to the pprint-linear function.

If the kind is :miser, then this function inserts a newline exactly like :linear, but only when in “miser mode”.  Miser mode takes effect whenever the start of the printing block is closer to the right margin than the value of the variable *print-miser-width*.  If miser mode is not in effect, this function never inserts a newline.

If the kind is :fill, then this function inserts a newline only when the current line cannot hold the next object to be printed.  The effect is to put as many objects on each line as possible before starting a new line.  Compare this to the pprint-fill function.

If the kind is :mandatory, the function always inserts a newline, unconditionally.

You should use pprint-newline in pprint-logical-block blocks, and avoid the use of format or terpri functions, as the latter do not integrate with the formatting behaviour of pretty-printing.  For instance, the pprint-indent function, which only takes effect after the next newline, is not guaranteed to do anything if you use format or terpri instead of pprint-newline.

Our exploration of pretty-printing has now reached the point where we’ll show real code instead of just describing some functions.  We’ve arrived at pprint-logical-block, which is the starting point for constructing pretty-printing functions.

The pprint-logical-block macro sets up a pretty-printing context inside of which the programmer writes his or her pretty-printing directives.  The required arguments are the stream and the object to be printed.  If the object to be printed is not a list, this macro simply sends the object to write, but if it is a list, then objects in the list can be retrieved with pprint-pop, and the logical block is exited by calling pprint-exit-if-list-exhausted.

One important restriction is that pprint-logical-block must not modify the values of variables not bound within the block itself.  The reason for this is that, during circularity detection, the entire block may be executed more than once, causing these side-effects to be invoked an unpredictable number of times.

So, now we will define a special pretty-printing function.  This function will act on lists whose first element is the keyword :SPECIAL.  In that case, this first entry in the list is skipped, and the following entries are printed out, one to a line, with an index number and the type, enclosed in brace brackets instead of parentheses, and with an SP: prefix to denote this behaviour:

(defun my-special-pprint (stream obj)
  (pprint-logical-block (stream obj 
                                :prefix "SP: { "
                                :suffix "}")
    (let ((ctr 0))
      (pprint-pop)
      (pprint-newline :mandatory stream)
      (do ()
          (nil)
        (pprint-exit-if-list-exhausted)
        (let ((entry (pprint-pop)))
          (write entry :stream stream)
          (pprint-tab :section-relative 6 6 stream)
          (format stream
                  "<--- Entry #~D.  ~A" 
                  ctr (type-of entry)))
        (incf ctr)
        (pprint-newline :mandatory stream)
        ))))

Next is the function that we use to demonstrate the new printing.  Notice that I set the *print-pretty* special variable in an enclosing let form to allow automatic restoration of its value after the various setf calls have finished modifying it.  We discussed this, and special variables in general, as an aside in the article on print.  Here is the function:

(defun demonstrate ()
  (set-pprint-dispatch '(cons (member :SPECIAL))
                       'my-special-pprint 10.0)

  (let ((list-1 (list 1.0d0 "2" :THREE '(:SPECIAL 4.0d0) 5.0d0))
        (list-2 (list :SPECIAL 1.0d0 "2" :THREE '(:SPECIAL 4.0d0) 5.0d0))
        (*print-pretty* nil))

    (setf *print-pretty* nil)
    (format t "Non-pretty-printing a list:~%")
    (print list-1)
    (setf *print-pretty* t)
    (terpri)
    (terpri)
    (terpri)
    (format t "Pretty-printing the same list:~%")
    (print list-1)
    (terpri)
    (terpri)
    (terpri)
    (setf *print-pretty* nil)
    (format t "Non-pretty-printing another list:~%")
    (print list-2)
    (terpri)
    (terpri)
    (terpri)
    (setf *print-pretty* t)
    (format t "Pretty-printing the second list:~%")
    (print list-2)
    (values)))

Finally, here is the output. You’ll notice that this function is recursively dispatched when appropriate.

CL-USER> (demonstrate)
Non-pretty-printing a list:

(1.0d0 "2" :THREE (:SPECIAL 4.0d0) 5.0d0) 


Pretty-printing the same list:

(1.0d0 "2" :THREE
 SP: {
       4.0d0       <--- Entry #0.  DOUBLE-FLOAT
       }
 5.0d0) 


Non-pretty-printing another list:

(:SPECIAL 1.0d0 "2" :THREE (:SPECIAL 4.0d0) 5.0d0) 


Pretty-printing the second list:

SP: {
      1.0d0       <--- Entry #0.  DOUBLE-FLOAT
      "2"         <--- Entry #1.  (SIMPLE-ARRAY CHARACTER (1))
      :THREE      <--- Entry #2.  KEYWORD
      SP: {
            4.0d0       <--- Entry #0.  DOUBLE-FLOAT
            }           <--- Entry #3.  CONS
      5.0d0       <--- Entry #4.  DOUBLE-FLOAT
      } 
; No value