Readtable: fix propagation of default handlers in trie paths

Previous version did (ACTION 'UPDATE (CDR REST) ACTION) when a new
action had to be made. This caused default actions to propagate
through the trie.

While this isn't bad (it causes #TRU to be equal to #TRUE when that
was the last prefix in the tree), it can cause unexpected errors at
runtime, and no program should ever depend on its behavior.

The current solution is to make a new PASS readtable with a default
error action.

read.scm

@@ -159,70 +159,6 @@
               (else (error "readtable:exec: invalid" args))))))
       exec)))
 
-;;; Define a new readtable.
-;;; 
-;;; (X) where (CHAR? X): Execute the action associated with X, or the
-;;; default action.
-;;; 
-;;; (WITH-DEFAULT-ACTION NEW-ACTION): Return a readtable with the same
-;;; backing table but with NEW-ACTION as the default action.
-;;; 
-;;; (UPDATE REST ACTION): Update the action taken by the total application
-;;; of REST to be ACTION. REST must be a pair.
-(define readtable:new
-  (lambda (default-action charmap)
-    (letrec
-        ((lookup?
-          (lambda (char)
-            (let ((node (charmap:search charmap char)))
-              (if (null? node)
-                  #f
-                  (map:val node)))))
-         (lookup
-          (lambda (char)
-            (or (lookup? char) default-action)))
-         (run*
-          (lambda (handler char acc port)
-            (handler 'step table char acc port)))
-         (run
-          (lambda (char acc port)
-            (run* (lookup char) char acc port)))
-         (with-default-action
-             (lambda (new-default-action)
-               (readtable:new new-default-action charmap)))
-         (update
-          (lambda (rest action)
-            (if (null? rest)
-                (error "readtable update: invalid" (list rest action))
-                (readtable:new default-action
-                               (charmap:update
-                                charmap
-                                (car rest)
-                                (lambda (_ oldnode)
-                                  (if (null? oldnode)
-                                      (action 'update (cdr rest) action)
-                                      ((map:val oldnode)
-                                       'update (cdr rest) action))))))))
-         (table
-          (lambda (op . args)
-            (cond
-              ((not op)
-               (apply run* default-action op args))
-              ((char? op) (apply run op args))
-              ((eq? op 'with-default-action) (apply with-default-action
-                                                    args))
-              ((eq? op 'update) (apply update args))
-              (else (error "readtable: invalid" args))))))
-      table)))
-
-;;; Add ACTION as the action to be taken in TABLE following SEQ.
-(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))))
 
 ;;; ;;;;;;;;;;;;;;;
 ;;; Default actions
@@ -258,6 +194,82 @@
      (lambda (table char acc port)
        value))))
 
+;;; Define a new readtable.
+;;; 
+;;; (X) where (CHAR? X): Execute the action associated with X, or the
+;;; default action.
+;;; 
+;;; (WITH-DEFAULT-ACTION NEW-ACTION): Return a readtable with the same
+;;; backing table but with NEW-ACTION as the default action.
+;;; 
+;;; (UPDATE REST ACTION): Update the action taken by the total application
+;;; of REST to be ACTION. REST must be a pair.
+(define readtable:new
+  (lambda (default-action charmap)
+    (letrec
+        ((lookup?
+          (lambda (char)
+            (let ((node (charmap:search charmap char)))
+              (if (null? node)
+                  #f
+                  (map:val node)))))
+         (lookup
+          (lambda (char)
+            (or (lookup? char) default-action)))
+         (run*
+          (lambda (handler char acc port)
+            (handler 'step table char acc port)))
+         (run
+          (lambda (char acc port)
+            (run* (lookup char) char acc port)))
+         (with-default-action
+             (lambda (new-default-action)
+               (readtable:new new-default-action charmap)))
+         (empty-pass/error
+          (lambda ()
+            (readtable:pass:new
+             (readtable:new (readtable:error-action
+                             "reading long name")
+                            '()))))
+         (update-oldnode
+          (lambda (rest action)
+            (lambda (_ oldnode)
+              (if (null? rest)
+                  action
+                  (let ((replaced (if (null? oldnode)
+                                      (empty-pass/error)
+                                      (map:val oldnode))))
+                    (replaced 'update rest action))))))
+         (update
+          (lambda (rest action)
+            (if (null? rest)
+                (error "readtable update: invalid" (list rest action))
+                (readtable:new default-action
+                               (charmap:update
+                                charmap
+                                (car rest)
+                                (update-oldnode (cdr rest) action))))))
+         (table
+          (lambda (op . args)
+            (cond
+              ((not op)
+               (apply run* default-action op args))
+              ((char? op) (apply run op args))
+              ((eq? op 'with-default-action) (apply with-default-action
+                                                    args))
+              ((eq? op 'update) (apply update args))
+              (else (error "readtable: invalid" (cons op args)))))))
+      table)))
+
+;;; Add ACTION as the action to be taken in TABLE following SEQ.
+(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))))
+
 ;;; ;;;;;;;;;;;;;;;;;;;
 ;;; Default readtables
 ;;; ;;;;;;;;;;;;;;;;;;;
@@ -285,7 +297,6 @@
 ;;; ;;;;;;;;;;;
 ;;; Test reader
 ;;; ;;;;;;;;;;;
-
 (define %list->read
   (lambda (seq)
     (port->read
@@ -297,6 +308,8 @@
              ch)))
      "test")))
 
-(let ((true-reader (%list->read (list #\# #\t #\r #\u #\e #\f))))
+(let ((true-reader (%list->read (string->list "#tro#f"))))
   (display (list "first:" (readtable:top (true-reader 'read) #f true-reader)))
-  (display (list "second: " (readtable:top (true-reader 'read) #f true-reader))))
+  (newline)
+  (display (list "second: " (readtable:top (true-reader 'read) #f true-reader)))
+  (newline))