;; Requires <a href="scan.html">scanner</a>
<xmp>
(define parse
  (lambda (str)
    (letrec
      ((push-until-right
	(lambda (tokens stk d)
	  (if (and (= d 0) (not (null? stk)))
	      (cons stk tokens)
	      (let ((u (car tokens)))
		(cond ((eq? u #\()
		       (push-until-right (cdr tokens) (cons u stk) (+ d 1)))
		      ((eq? u #\.)
		       (push-until-right (cdr tokens) (cons u stk) d))
		      ((or (symbol? u) (number? u))
		       (push-until-right (cdr tokens) (cons u stk) d))
		      ((eq? u #\')
		       (let* ((to-be-quoted (push-until-right (cdr tokens) () 0))
			      (quoted (list 'quote (caar to-be-quoted)))
			      (rest (cdr to-be-quoted)))
			 (push-until-right rest (cons quoted stk) d)))
		      ((eq? u #\))
		       (push-until-right (cdr tokens) (pop-until-left stk ()) (- d 1)))
		      (else 
		       (error "parse error.")))))))
       (pop-until-left
	(lambda (stk acc)
	  (let ((u (car stk)))
	    (if (eq? u #\()
		(cons acc (cdr stk))
		(if (eq? u #\.)
		    (if (null? (cdr acc))
			(pop-until-left (cdr stk) (car acc))
			(error "parse error."))
		    (pop-until-left (cdr stk) (cons u acc))))))))
      (caar (push-until-right (scan (string->list str)) () 0)))))

(define expr->string
  (lambda (s)
    (letrec
      ((cdr->string
	(lambda (ls)
	  (cond ((null? ls) "")
		((pair? ls)
		 (let ((rest (cdr ls)))
		   (string-append
		    " "
		    (expr->string (car ls))
		    (cond ((null? rest) "")
			  ((pair? rest)
			   (cdr->string rest))
			  (else
			   (string-append
			    " . "
			    (expr->string rest)))))))
		(else
		 (string-append
		  " . "
		  (expr->string ls)))))))
      (cond ((null? s) "()")
	    ((pair? s)
	     (string-append
	      "("
	      (expr->string (car s))
	      (cdr->string (cdr s))
	      ")"))
	    ((number? s)
	     (number->string s))
	    ((symbol? s)
	     (symbol->string s))
	    (else
	     (error 'expr->string "Unreadable type."))))))

(define do-nothing
  (lambda (str)
    (expr->string (parse str))))
</xmp>