From 40b129b0db3330075fd35da4252bbe5963746979 Mon Sep 17 00:00:00 2001 From: Peter McGoron Date: Sat, 7 Sep 2024 17:58:18 -0400 Subject: [PATCH] readtable: correctly add trie values. Incorrectly propogates default procedure --- read.scm | 36 +++++++++++++++++++----------------- 1 file 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))))