[gls@Think.COM: Re: compiler-let]

[Guy Steele <gls@Think.COM>]

    Date: Mon, 7 Jul 86 17:10:25 MDT
    From: shebs%utah-orion@utah-cs.ARPA (Stanley Shebs)
    ...
    Methinks there is a tongue pressed into cheek somewhere, but I'll answer
    bravely anyway:  COMPILER-LET takes honors as the most bogus item in
    Common Lisp, with the possible exception of certain format directives
    (GLS's example of the FORMAT-ERROR function is an unusually subtle joke -
    "looks pretty flashy when done properly"!).

In this connection, I would like to nominate the following for Most Unreadable
Format Control String in Production Code:

"~:[{~;[~]~:{~S~:[!~S~;~*~]~:^ ~}~:[ ~]~{~S!~^ ~}~:[ ~]~[~*~;!~S~;. ~S~;!~*~]~:[}~;]~]"

I am not kidding; I wrote this as part of the Connection Machine Lisp simulator,
and it really does do exactly what I want.  It is part of the printing function
for a data structure called a xapping, whose syntax involves brackets or braces
under various circumstances.  Here is the entire printing function:

(defun print-xapping (xapping stream depth)
  (declare (ignore depth))
  (format stream
	  "~:[{~;[~]~:{~S~:[!~S~;~*~]~:^ ~}~:[ ~]~{~S!~^ ~}~:[ ~]~[~*~;!~S~;. ~S~;!~*~]~:[}~;]~]"
	  ;\_______/\_____________________/\____/\________/\____/\____________________/\_______/
	  (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)))
	  (not (and (xapping-domain xapping)
		    (or (xapping-exceptions xapping)
			(xapping-infinite xapping))))
	  (xapping-exceptions xapping)
	  (not (or (and (xapping-exceptions xapping)
			(xapping-infinite xapping))
		   (and (eq (xapping-infinite xapping) :lazy)
			(null (xapping-domain xapping))
			(null (xapping-exceptions xapping)))))
	  (ecase (xapping-infinite xapping)
	    (:constant 1)
	    (:lazy 2)
	    (:universal 3)
	    ((nil) 0))
	  (xapping-default xapping)
	  (xectorp xapping)))