Format Stinks

Drew McDermott thinks format stinks. And he has an alternative.

He takes on what Guy Steele called “the hairiest format control string I have ever seen,” used for printing the xapping data types in Connection Machine Lisp:

----------------------------------------------------------------
Table 22-8: Print Function for the Xapping Data Type

(defun print-xapping (xapping stream depth) 
  (declare (ignore depth)) 
  (format stream 
          ;; Are you ready for this one? 
          "~:[{~;[~]~:{~S~:[->~S~;~*~]~:^ ~}~:[~; ~]~ 
           ~{~S->~^ ~}~:[~; ~]~[~*~;->~S~;->~*~]~:[}~;]~]" 
          ;; Is that clear? 
          (xectorp xapping) 
          (do ((vp (xectorp xapping)) 
               (sp (finite-part-is-xetp xapping)) 
               (d (xapping-domain xapping) (cdr d)) 
               (r (xapping-range xapping) (cdr r)) 
               (z '() (cons (list (if vp (car r) (car d)) 
                                  (or vp sp) 
                                  (car r)) 
                            z))) 
              ((null d) (reverse z))) 
          (and (xapping-domain xapping) 
               (or (xapping-exceptions xapping) 
                   (xapping-infinite xapping))) 
          (xapping-exceptions xapping) 
          (and (xapping-exceptions xapping) 
               (xapping-infinite xapping)) 
          (ecase (xapping-infinite xapping) 
            ((nil) 0) 
            (:constant 1) 
            (:universal 2)) 
          (xapping-default xapping) 
          (xectorp xapping)))

Drew says “Folks, you don't have to put up with this nonsense. Here is the civilized way to write the print-function.”

(defun print-xapping (xapping stream depth)
   (declare (ignore depth))
   (out (:to stream)
      ;; Print ``['' for a xector, and ``{'' otherwise. 
      (:q ((xectorp xapping) "[")
      (t "{"))

      ;; Print the pairs implied by the xapping.
      ;; Whether the element to the left of the arrow comes from
      ;; the list 'd' or the list 'r' depends on whether the
      ;; xapping is a xector.  An arrow is printed only if
      ;; xapping is not a xector or a xet.  The element to the
      ;; right of the arrow always comes from 'r'.
      ;; Each pair is followed by a space, except the last.
      (:e (do ((vp (xectorp xapping))
           (sp (finite-part-is-xetp xapping))
           (d (xapping-domain xapping) (cdr d))
           (r (xapping-range xapping) (cdr r)))
          ((null d))
         (:o (if vp (car r) (car d))
         (:q ((not (or vp sp)) "->"))
         (car r)
         (:q ((not (null (cdr d))) " ")))))

      ;; If there were pairs and there are exceptions or an infinite part,
      ;; print a separating space. 
      (:q ((and (xapping-domain xapping)
        (or (xapping-exceptions xapping)
            (xapping-infinite xapping)))
       " "))

      ;; Given a list of exception indices, print them.
      (:e (do ((el (xapping-exceptions xapping) (cdr el)))
          ((null el))
         (:o (car el)
         (:q ((not (null (cdr el))) " ")))))

      ;; If there were exceptions and there is an infinite part,
      ;; print a separating space.
      (:q ((and (xapping-exceptions xapping) (xapping-infinite xapping))
       " "))

      ;; The infinite part is omitted if nil, printed as "->k" if it's a
      ;; constant k, and printed as "->" if it's "universal"
     (:e (ecase (xapping-infinite xapping)
        ((nil))
        (:constant (:o "->" (xapping-default xapping)))
        (:universal (:o "->"))))

     ;; Print ``]'' for a xector, and ``}'' otherwise. 
     (:q ((xectorp xapping) "]")
     (t "}"))))

Posted by jjwiseman at November 18, 2005 12:20 PM