(define (html->sexpr fn) (define (read-token endc) (let loop ((c (read-char))
(r '())) (if (or (eof-object? c) (char=? c endc)) (list->string (reverse r))
(loop (read-char) (cons c r))))) (with-input-from-file fn (lambda () (let loop
((c(read-char)) (stack '())) (cond ((eof-object? c) (if (pair? stack) (car
stack) stack)) ((char=? c #\<) (let ((tag (read-token #\>))) (if (char=? #\/
(string-ref tag 0)) (let* ((x (substring tag 1)) (v (find (lambda (s) (if
(string-ci=? (first-token x) (first-token (car s))) (car s) #f)) stack)))
(if v (let loop1 ((stack stack) (r '())) (if (not (eq? v (caar stack)))
(loop1 (cdr stack) (cons (cons (caar stack) (cdar stack)) r)) (begin
(set-cdr! (car stack) (append (cdar stack) r)) (if (pair?
(cdr stack)) (begin (set-cdr! (cadr stack) (append (cdadr stack) (list (car
stack)))) (loop (read-char) (cdr stack))) (loop (read-char) stack))))) (begin
(stdout-puts "警告:" tag "は対応関係が異常です") (loop (read-char) stack))))
(begin (if (memv (first-token tag) *omit-tag-list*) (begin (set-cdr! (car stack)
(append (cdar stack) (list (list tag)))) (loop (read-char) stack)) (loop
(read-char) (cons (list tag) stack))))))) (else (let ((s (string-append (string
c) (read-token #\<)))) (if (pair? stack) (set-cdr! (car stack) (append (cdar
stack) (list s))) (stdout-puts "警告:" s "はばどのタグにも所属してません"))
(let ((xc (peek-char))) (if (eof-object? xc) (loop xc stack) (loop #\< stack
))))))))))

stdout-putsは強制的に標準出力などに吐くputsです。
(with-input-to-fileを使用してるので)
putsは最後に改行するdisplay*です。
display*は引数リスト全てにdisplayを適用する関数です。