lisp parsing lisp

parse.lisp

(defun read-list (stream)
  (if (char= (peek-char t stream) #\))
      (progn
        (read-char stream) 
        nil)
      (cons (read-sexp stream)
            (read-list stream))))

(defun read-atom (stream &optional (collected nil))
  (let ((char (peek-char (null collected) stream nil :eof)))
    (cond
      ((eql char :eof)
       (intern
        (string-upcase
         (coerce (nreverse collected) 'string))))
      ((member char
               '(#\Space #\Newline #\Tab #\( #\))
               :test #'char=)
       (intern
        (string-upcase
         (coerce (nreverse collected) 'string))))
      (t
       (read-atom stream
                  (cons (read-char stream)
                        collected))))))

(defun handle-escape (stream)
  (let ((char (read-char stream)))
    (case char
      (#\" #\")
      (otherwise
       (error "Escape ~a not implemented" char)))))

(defun read-string (stream &optional (collected nil))
  (let ((char (read-char stream)))
    (case char
      (#\"
       (coerce (nreverse collected) 'string))
      (#\Backslash
       (read-string stream
                    (cons (handle-escape stream)
                          collected)))
      (otherwise
       (read-string stream
                    (cons char collected))))))

(defun read-sexp (stream)
  (let ((char (read-char stream)))
    (case char
      (#\(
       (read-list stream))
      (#\"
       (read-string stream (list char)))
      (otherwise
       (read-atom stream (list char))))))
   
(defun read-from-string* (string)
  (with-input-from-string (stream string)
    (read-sexp stream)))