read: factor out improper list reader

read.scm

@@ -196,6 +196,10 @@
     (lambda (oldtable char acc port)
       (readtable:act newtable char acc port))))
 
+;;; ;;;;;;;;;;;;;;;;;
+;;; Identifier reader
+;;; ;;;;;;;;;;;;;;;;;
+
 ;;; Push back CHAR and return ACC.
 (define readtable:return-acc-keep-char
   (lambda (table char acc port)
@@ -245,6 +249,10 @@
                      (port 'read) lst port)
         'to-list)))))
 
+;;; ;;;;;;;;;;;;;;;;;;;;
+;;; Comments and whitespace reader
+;;; ;;;;;;;;;;;;;;;;;;;;
+
 ;;; Add all chars in TO-SKIP to TABLE as skipped characters. Used for
 ;;; whitespace.
 (define readtable:add-all-as-skip
@@ -260,6 +268,14 @@
    (readtable:empty/default readtable:skip)
    (list readtable:update #\newline (readtable:return #f))))
 
+;;; ;;;;;;;;;;;
+;;; List reader
+;;; 
+;;; The reader updates the previous readtable to handle ). This means
+;;; that this read table does not have to handle end-of-line, whitespace,
+;;; etc.
+;;; ;;;;;;;;;;;
+
 ;;; Read the end of an improper list.
 (define readtable:read-improper-cdr
   (lambda (table acc port)
@@ -277,35 +293,14 @@
                                               "improper list has 1 cdr"))
                     (list readtable:add-all-as-skip readtable:ASCII-whitespace)
                     (list readtable:update %eol
-                          (lambda dummy acc)))))
+                          (lambda dummy 'end-of-list)))))
         (readtable:act table (port 'read) acc port)))))
 
-;;; List reader.
-;;; 
-;;; The reader updates the previous readtable to handle ). This means
-;;; that this read table does not have to handle end-of-line, whitespace,
-;;; etc.
-(define readtable:read-list
-  (lambda (oldtable char acc port)
-    (let ((acc (linked-list:new))
-          (table (readtable:process
-                  oldtable
-                  (list readtable:update %eol
-                        (readtable:return 'end-of-list))
-                  (list readtable:update #\.
-                        (lambda (table char acc port)
-                          (let ((id (readtable:read-ident
-                                     table
-                                     char
-                                     #f
-                                     port)))
-                            ;; todo: list needs a car
-                            (if (equal? id ".")
-                                (begin
-                                  (readtable:read-improper-cdr
-                                   oldtable acc port)
-                                  'end-of-list)
-                                id)))))))
+;;; Generic reader loop for a list. It takes as input the table that has
+;;; already been updated with end of list and improper list handlers.
+(define readtable:read-list-loop
+  (lambda (table port)
+    (let ((acc (linked-list:new)))
       (letrec ((loop
                 (lambda ()
                   (let ((value (readtable:act table
@@ -318,6 +313,32 @@
                             (loop)))))))
         (loop)))))
 
+;;; Readtable for a list, generic to proper and improper list
+;;; readers.
+(define readtable:table-for-list
+  (lambda (oldtable on-dot)
+    (readtable:process
+     oldtable
+     (list readtable:update %eol (readtable:return 'end-of-list))
+     (list readtable:update #\.
+           (lambda (table char acc port)
+             (let ((entire-identifier (readtable:read-ident
+                                       table
+                                       char
+                                       #f
+                                       port)))
+               (if (equal? entire-identifier ".")
+                   (on-dot table acc port)
+                   entire-identifier)))))))
+
+;;; Read a proper or improper list.
+(define readtable:read-list
+  (lambda (oldtable _ __ port)
+    (readtable:read-list-loop (readtable:table-for-list
+                               oldtable
+                               readtable:read-improper-cdr)
+                              port)))
+
 ;;; Toplevel reader.
 ;;; This is defined as a function so that it dynamically loads each
 ;;; sub-readtable.
@@ -366,3 +387,4 @@
 (read-all "(a   b    c     def (ghi j)  k    )")
 (read-all "(      a . b   )")
 (read-all "(   a .b . c)")
+