readtable: comments

read.scm

@@ -33,6 +33,7 @@
 ;;; (READ): Read the next character in the stream. Returns #F on EOF.
 ;;; (PUSH CHAR): Push CHAR such that it will be the next character read
 ;;; when (READ) is called.
+;;; (PEEK): Read character, push it back, and return it.
 ;;; (FOLD-CASE?): Returns a boolean if case folding is enabled.
 ;;; (FOLD-CASE! BOOL): Sets the case folding to BOOL.
 (define port->read
@@ -65,6 +66,10 @@
                           (let ((ch (car pushback-buffer)))
                             (set! pushback-buffer (cdr pushback-buffer))
                             ch))))
+                    ((eq? op 'peek)
+                     (let ((ch (port 'read)))
+                       (port 'push ch)
+                       ch))
                     ((eq? op 'push)
                      (let ((ch (car args)))
                        (if (eqv? ch #\newline)
@@ -159,6 +164,20 @@
   (lambda (table char acc port)
     (readtable:act table (port 'read) acc port)))
 
+;;; Discard char and return constant.
+(define readtable:return
+  (lambda (return)
+    (lambda (table char acc port)
+      return)))
+
+;;; Jump to a new readtable, discard it's return, and continue reading
+;;; in the table.
+(define readtable:jump-discard
+  (lambda (newtable)
+    (lambda (oldtable char acc port)
+      (readtable:act newtable (port 'read) '() port)
+      (readtable:act oldtable (port 'read) acc port))))
+
 ;;; Push back CHAR and return ACC.
 (define readtable:return-acc-keep-char
   (lambda (table char acc port)
@@ -212,11 +231,19 @@
           table
           to-skip)))
 
+;;; Readtable for a line comment.
+(define readtable:read-to-newline
+  (readtable:process
+   (readtable:empty/default readtable:skip)
+   (list readtable:update #\newline (readtable:return #f))))
+
 ;;; Toplevel reader.
 (define readtable:top
   (readtable:process
    (readtable:empty/default readtable:read-ident)
-   (list readtable:add-all-as-skip readtable:ASCII-whitespace)))
+   (list readtable:add-all-as-skip readtable:ASCII-whitespace)
+   (list readtable:update #\;
+         (readtable:jump-discard readtable:read-to-newline))))
 
 ;;; ;;;;;;;;;;;
 ;;; Test reader
@@ -232,13 +259,22 @@
              ch)))
      "test")))
 
-(let ((true-reader (%list->read (string->list "xyzw    abcd    x!"))))
+(define read-all
-  (display (list "first:" (readtable:act
+  (lambda (str)
-                           readtable:top (true-reader 'read) #f true-reader)))
+    (let ((reader (%list->read (string->list str))))
-  (newline)
+      (letrec ((loop
-  (display (list "second: " (readtable:act
+                (lambda ()
-                             readtable:top (true-reader 'read) #f true-reader)))
+                  (if (not (reader 'peek))
-  (newline)
+                      #t
-  (display (list "third: " (readtable:act
+                      (let ((value (readtable:act
-                            readtable:top (true-reader 'read) #f true-reader)))
+                                    readtable:top (reader 'read)
-  (newline))
+                                    #f
+                                    reader)))
+                        (display (list "return" value))
+                        (newline)
+                        (loop))))))
+        (loop)))))
+
+(read-all "x yy zz ; this is a comment\nx")
+
+