readtable: when adding sequences to the readtable, push the last
read character back to the character reader before executing the action. This fixes the issue where sequences eat characters in front of them.
This commit is contained in:
parent
530dd18087
commit
3f56b03f1a
19
read.scm
19
read.scm
|
@ -70,7 +70,7 @@
|
|||
(set! offset #f))
|
||||
(set! offset (- offset 1)))
|
||||
(set! pushback-buffer (cons ch pushback-buffer))))
|
||||
(else (error "read->port: invalid" args))))))))
|
||||
(else (error "read->port: invalid" (cons op args)))))))))
|
||||
|
||||
;;; ;;;;;;;;;;;;;;
|
||||
;;; Character maps
|
||||
|
@ -272,6 +272,19 @@
|
|||
(else (error "readtable: invalid" (cons op args)))))))
|
||||
table)))
|
||||
|
||||
;;; Wrap ACTION in a readtable, and push bach the currently read character
|
||||
;;; before calling ACTION.
|
||||
;;;
|
||||
;;; This is designed for readtable actions that already know what they
|
||||
;;; are matching against.
|
||||
(define readtable:sequence-wrapper
|
||||
(lambda (action)
|
||||
(readtable:pass/blank
|
||||
(readtable:exec:new
|
||||
(lambda (table char acc port)
|
||||
(port 'push char)
|
||||
(action 'step table #f #f port))))))
|
||||
|
||||
;;; Add ACTION as the action to be taken in TABLE following SEQ.
|
||||
;;; The action is wrapped in an empty PASS table with ACTION as the default
|
||||
;;; action. This normalizes the character ACTION is passed.
|
||||
|
@ -281,7 +294,7 @@
|
|||
((char? seq) (list seq))
|
||||
((string? seq) (string->list seq))
|
||||
(else seq))))
|
||||
(table 'update seq (readtable:pass/blank action)))))
|
||||
(table 'update seq (readtable:sequence-wrapper action)))))
|
||||
|
||||
;;; ;;;;;;;;;;;;;;;;;;;
|
||||
;;; Default readtables
|
||||
|
@ -321,7 +334,7 @@
|
|||
ch)))
|
||||
"test")))
|
||||
|
||||
(let ((true-reader (%list->read (string->list "#true#f"))))
|
||||
(let ((true-reader (%list->read (string->list "#t#false#true"))))
|
||||
(display (list "first:" (readtable:top (true-reader 'read) #f true-reader)))
|
||||
(newline)
|
||||
(display (list "second: " (readtable:top (true-reader 'read) #f true-reader)))
|
||||
|
|
Loading…
Reference in New Issue