readtable: correctly add trie values. Incorrectly propogates default procedure

1 files changed, 19 insertions, 17 deletions

diff --git a/read.scm b/read.scm
index 0089232..440d910 100644
--- a/read.scm
+++ b/read.scm
@@ -144,17 +144,20 @@
 ;;; as the default action, and run (UPDATE REST ACTION) on it.
 (define readtable:exec:new
   (lambda (proc)
-    (let ((update
-           (lambda (rest action)
-             (if (null? rest)
-                 action
-                 ((readtable:pass:new readtable:empty)
-                  'update rest action)))))
-      (lambda (op . args)
-        (cond
-          ((eq? op 'update) (apply update args))
-          ((eq? op 'step) (apply proc args))
-          (else (error "readtable:exec: invalid" args)))))))
+    (letrec
+        ((update
+          (lambda (rest action)
+            (if (null? rest)
+                action
+                ((readtable:pass:new (readtable:new exec '()))
+                 'update rest action))))
+         (exec
+          (lambda (op . args)
+            (cond
+              ((eq? op 'update) (apply update args))
+              ((eq? op 'step) (apply proc args))
+              (else (error "readtable:exec: invalid" args))))))
+      exec)))
 
 ;;; Define a new readtable.
 ;;; 
@@ -204,7 +207,6 @@
           (lambda (op . args)
             (cond
               ((not op)
-               (display (list op args))
                (apply run* default-action op args))
               ((char? op) (apply run op args))
               ((eq? op 'with-default-action) (apply with-default-action
@@ -277,7 +279,8 @@
    readtable:empty
    (cons "#t" (readtable:return-value #t))
    (cons "#f" (readtable:return-value #f))
-   (cons "#true" (readtable:return-value #t))))
+   (cons "#true" (readtable:return-value #t))
+   (cons "#trouble" (readtable:return-value 15))))
 
 ;;; ;;;;;;;;;;;
 ;;; Test reader
@@ -294,7 +297,6 @@
              ch)))
      "test")))
 
-(let ((true-reader (%list->read (list #\# #\t))))
-  (readtable:top (true-reader 'read) #f true-reader))
-
-
+(let ((true-reader (%list->read (list #\# #\t #\r #\u #\e #\f))))
+  (display (list "first:" (readtable:top (true-reader 'read) #f true-reader)))
+  (display (list "second: " (readtable:top (true-reader 'read) #f true-reader))))