readtable: Normalize character handled by ACTIONs at the end of

sequences.

Previously, if "#true" and "#t" were in the readtable as sequences,
the string "#true" would call "#true"'s EXEC function after reading
"e", but it would call "#t"'s EXEC function after reading a
character after "t" (which could be EOF).

The new behavior normalizes everything so that the ACTIONs read the
character after the sequence.

1 files changed, 15 insertions, 8 deletions

diff --git a/read.scm b/read.scm
index a138041..cd81daf 100644
--- a/read.scm
+++ b/read.scm
@@ -140,6 +140,12 @@
           ((eq? op 'step) (apply step args))
           (else (error "readtable:pass: invalid" args)))))))
 
+;;; Create a new PASS with a blank TABLE with DEFAULT-ACTION as the
+;;; default action.
+(define readtable:pass/blank
+  (lambda (default-action)
+    (readtable:pass:new (readtable:new default-action '()))))
+
 ;;; Execute an action.
 ;;; 
 ;;; STEP calls PROC with the same arguments.
@@ -170,7 +176,8 @@
 ;;; Default actions
 ;;; ;;;;;;;;;;;;;;;
 
-(define readtable:update-many
+;;; Add multiple literal sequences to the readtable.
+(define readtable:update-many-sequence
   (lambda (table . pairs)
     (fold (lambda (pair table)
             (readtable:add-sequence table (car pair)
@@ -233,10 +240,8 @@
                (readtable:new new-default-action charmap)))
          (empty-pass/error
           (lambda ()
-            (readtable:pass:new
-             (readtable:new (readtable:error-action
-                             "reading long name")
-                            '()))))
+            (readtable:pass/blank (readtable:error-action
+                                   "reading long name"))))
          (update-oldnode
           (lambda (rest action)
             (lambda (_ oldnode)
@@ -268,13 +273,15 @@
       table)))
 
 ;;; Add ACTION as the action to be taken in TABLE following SEQ.
+;;; The action is wrapped in an empty PASS table with ACTION as the default
+;;; action. This normalizes the character ACTION is passed.
 (define readtable:add-sequence
   (lambda (table seq action)
     (let ((seq (cond
                  ((char? seq) (list seq))
                  ((string? seq) (string->list seq))
                  (else seq))))
-      (table 'update seq action))))
+      (table 'update seq (readtable:pass/blank action)))))
 
 ;;; ;;;;;;;;;;;;;;;;;;;
 ;;; Default readtables
@@ -293,7 +300,7 @@
                          (cons #\newline (readtable:return-value #f))))))
 
 (define readtable:top
-  (readtable:update-many
+  (readtable:update-many-sequence
    readtable:empty
    (cons "#t" (readtable:return-value #t))
    (cons "#f" (readtable:return-value #f))
@@ -314,7 +321,7 @@
              ch)))
      "test")))
 
-(let ((true-reader (%list->read (string->list "#tro#f"))))
+(let ((true-reader (%list->read (string->list "#true#f"))))
   (display (list "first:" (readtable:top (true-reader 'read) #f true-reader)))
   (newline)
   (display (list "second: " (readtable:top (true-reader 'read) #f true-reader)))