readtable: correctly add trie values. Incorrectly propogates default procedure
This commit is contained in:
parent
53a174f8e2
commit
40b129b0db
22
read.scm
22
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
|
||||
(letrec
|
||||
((update
|
||||
(lambda (rest action)
|
||||
(if (null? rest)
|
||||
action
|
||||
((readtable:pass:new readtable:empty)
|
||||
'update 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)))))))
|
||||
(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))))
|
||||
|
|
Loading…
Reference in New Issue