X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=reader.lisp;h=b516fbde41628189d3b6b34b033d27114ff3134f;hb=44268235a26004f1a01d0dcb61618c8cd35ec8b0;hp=9a07bd91359f2fce4da237dd3ab1d42101dae024;hpb=2b563a52d35859c1519c05bf97465093876b151c;p=jscl.git

diff --git a/reader.lisp b/reader.lisp
index 9a07bd9..b516fbd 100644
--- a/reader.lisp
+++ b/reader.lisp
@@ -23,7 +23,7 @@
 (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)))
 
@@ -38,25 +38,40 @@
        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 #\")))
@@ -64,12 +79,10 @@
       ((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)
@@ -77,5 +90,5 @@
              (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)))