; invoke like this: 
; $ clisp consdiagram.cl "(a (b c ((d))))"

(setq counter 0)
(defun get-index ()
  (let ((x counter))
    (progn
      (setq counter (1+ counter))
      x)))

(defun new-node ()
  (format nil "node~D" (get-index)))

(defun rank (nodes)
  (format t "    { rank = same ;~{ ~A;~}}~%" (mapcar #'first nodes)))

(defun make-node-access (nodes)
  (let ((f (first nodes)))
    (if (rest f)
      (string-concat (first f) ":car")
      (first f))))

(defun draw-cons (x) ; (neq l nil)
  (let ((nodename (new-node)))
    (cond
      ((null x) ())
      ((atom x)
       (format t "    ~A [shape=\"plaintext\", label=\"~A\"]; /* ~A */ ~%" nodename x x)
       (list (list nodename)))
      (t 
        (format t "    ~A [label=\"<car>|<cdr>~:[/~;~]\"] ; /* ~A */ ~%" nodename (rest x) x)
        (let ((followings (draw-cons (rest x)))
              (subnodes (draw-cons (first x))))
          (rank subnodes)
          (format t "    ~A:car -> ~A ; /* ~A */ ~%" nodename (make-node-access subnodes) x)
          (when followings
            (format t "    ~A:cdr -> ~A ; /* ~A */ ~%" nodename (make-node-access followings) x))
          (cons (cons nodename t) followings))))))

(defun draw-diagram (l)
  (progn
    (format t "/*~A*/~%" l)
    (format t "digraph consdiagram {~%")
    (format t "    node [shape=record, heigth=0.5, width=1.0] ;~%")
    (rank (draw-cons l))
    (format t "}~%")))


(if EXT:*ARGS*
  (draw-diagram (read-from-string (first EXT:*ARGS*)))
  (format t "must give me some list! as a string"))