:say macro for print debugging

say.lisp

;; (:say foo bar)
;;  => FOO = <VALUE>, BAR = <VALUE>

;; (:say (:val foo)) 
;;  => <VALUE>

;; (:say (:val foo) (:val bar)) 
;; => <VALUE><VALUE>

;; (:say (:val foo) " " (:val bar))
;; => <VALUE> <VALUE>

;; (:say foo :br bar) 
;; => <VALUE>
;; <VALUE>

(defvar *say-io* *debug-io*)
(defvar *return-value* nil)

(defmacro :say (&rest vars)
  (let (formats vals (tabbing 0))
    (labels
        ((join (&rest strings)
           (apply #'concatenate 'string strings))
         (format-expr (var more-exprs-p)
           (push (join (format nil "~~~A,0T" tabbing)
                       (if more-exprs-p "~A = ~S, " "~A = ~S"))
                 formats)
           (if (symbolp var)
               (push (symbol-name var) vals)
               (push `',var vals))
           (push var vals))
         (format-val (val &optional (with-space-p nil))
           (if with-space-p
               (push "~A " formats)
               (push "~A" formats))
           (push val vals)))
      (loop for x on vars
            as var = (car x)
            as next = (cdr x)
            as next-expr-p = (and next (not (stringp (car next))))
            do (typecase var
                 ((or string number) (format-val var))
                 (keyword
                  (case var
                    (:br (push "~%" formats))))
                 (list
                  (case (car var)
                    (:tab (setf tabbing (cadr var)))
                    ((:val :vals)
                     (mapcar #'format-val (cdr var)
                             (maplist (lambda (x) (and (cdr x) t))
                                      (cdr var))))
                    (t (format-expr var next-expr-p))))
                 (t (format-expr var next-expr-p))))
      `(let ((*return-value*))
         (format *say-io*
                 ,(join "~&" (apply #'join (nreverse formats)) "~%")
                 ,@(nreverse vals))
         *return-value*))))