(defun whitespacep (ch)
(or (char= ch #\space) (char= ch #\newline) (char= ch #\tab)))
-(defun skip-whitespace (stream)
+(defun skip-whitespaces (stream)
(loop for ch = (%peek-char stream)
while (whitespacep ch) do (%read-char stream)))
do (%read-char stream))
string))
-(defun %read-delimited-list (stream last bq-level)
- (loop for ch = (prog2 (skip-whitespace stream)
- (%peek-char stream))
- until (char= ch last)
- collect (ls-read-1 stream bq-level)
- finally (%read-char stream)))
+(defun skip-whitespaces-and-comments (stream)
+ (skip-whitespaces stream)
+ (when (char= (%peek-char stream) #\;)
+ (read-until stream (lambda (x) (eql x #\newline)))
+ (skip-whitespaces-and-comments stream)))
-(defun ls-read-1 (stream bq-level)
+(defun %read-list (stream)
+ (skip-whitespaces-and-comments stream)
+ (let ((ch (%peek-char stream)))
+ (cond
+ ((char= ch #\))
+ (%read-char stream)
+ nil)
+ ((char= ch #\.)
+ (%read-char stream)
+ (prog1 (ls-read-1 stream)
+ (skip-whitespaces-and-comments stream)
+ (unless (char= (%read-char stream) #\))
+ (error "')' was expected."))))
+ (t
+ (cons (ls-read-1 stream) (%read-list stream))))))
+
+(defun ls-read-1 (stream)
(let ((ch (%peek-char stream)))
(cond
((char= ch #\()
(%read-char stream)
- (%read-delimited-list stream #\) bq-level))
+ (%read-list stream))
((char= ch #\')
(%read-char stream)
- (list 'quote (ls-read-1 stream bq-level)))
+ (list 'quote (ls-read-1 stream)))
((char= ch #\`)
(%read-char stream)
- (list 'backquote (ls-read-1 stream (1+ bq-level))))
+ (list 'backquote (ls-read-1 stream)))
((char= ch #\")
(%read-char stream)
(prog1 (read-until stream (lambda (ch) (char= ch #\")))
((char= ch #\;)
(read-until stream (lambda (ch) (or (null ch) (char= ch #\newline))))
(%read-char stream)
- (ls-read-1 stream bq-level))
+ (ls-read-1 stream))
((char= ch #\,)
(%read-char stream)
- (unless (plusp bq-level)
- (error "Comma not inside a backquote."))
- (list 'comma (ls-read-1 stream (1- bq-level))))
+ (list 'comma (ls-read-1 stream)))
(t
(let ((string (read-until stream #'terminalp)))
(if (every #'digit-char-p string)
(intern (string-upcase string))))))))
-(defun ls-read (string)
- (ls-read-1 (make-stream string) 0))
+(defun ls-read-from-string (string)
+ (ls-read-1 (make-stream string)))