;; Requires scanner
(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))))