peter
/
UNSLISP
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

readtable: correctly add trie values. Incorrectly propogates default procedure

This commit is contained in:
Peter McGoron 2024-09-07 17:58:18 -04:00
parent 53a174f8e2
commit 40b129b0db
1 changed files with 19 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
read.scm
View File

@ -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))))