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

readtable: Normalize character handled by ACTIONs at the end of 

sequences.

Previously, if "#true" and "#t" were in the readtable as sequences,
the string "#true" would call "#true"'s EXEC function after reading
"e", but it would call "#t"'s EXEC function after reading a
character after "t" (which could be EOF).

The new behavior normalizes everything so that the ACTIONs read the
character after the sequence.
This commit is contained in:
Peter McGoron 2024-09-07 19:14:09 -04:00
parent 42cd5a0678
commit 530dd18087
1 changed files with 15 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
read.scm
View File

@ -140,6 +140,12 @@
((eq? op 'step) (apply step args)) ((eq? op 'step) (apply step args))
(else (error "readtable:pass: invalid" args))))))) (else (error "readtable:pass: invalid" args)))))))
;;; Create a new PASS with a blank TABLE with DEFAULT-ACTION as the
;;; default action.
(define readtable:pass/blank
(lambda (default-action)
(readtable:pass:new (readtable:new default-action '()))))
;;; Execute an action. ;;; Execute an action.
;;; ;;;
;;; STEP calls PROC with the same arguments. ;;; STEP calls PROC with the same arguments.
@ -170,7 +176,8 @@
;;; Default actions ;;; Default actions
;;; ;;;;;;;;;;;;;;; ;;; ;;;;;;;;;;;;;;;
(define readtable:update-many ;;; Add multiple literal sequences to the readtable.
(define readtable:update-many-sequence
(lambda (table . pairs) (lambda (table . pairs)
(fold (lambda (pair table) (fold (lambda (pair table)
(readtable:add-sequence table (car pair) (readtable:add-sequence table (car pair)
@ -233,10 +240,8 @@
(readtable:new new-default-action charmap))) (readtable:new new-default-action charmap)))
(empty-pass/error (empty-pass/error
(lambda () (lambda ()
(readtable:pass:new (readtable:pass/blank (readtable:error-action
(readtable:new (readtable:error-action "reading long name"))))
"reading long name")
'()))))
(update-oldnode (update-oldnode
(lambda (rest action) (lambda (rest action)
(lambda (_ oldnode) (lambda (_ oldnode)
@ -268,13 +273,15 @@
table))) table)))
;;; Add ACTION as the action to be taken in TABLE following SEQ. ;;; 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.
(define readtable:add-sequence (define readtable:add-sequence
(lambda (table seq action) (lambda (table seq action)
(let ((seq (cond (let ((seq (cond
((char? seq) (list seq)) ((char? seq) (list seq))
((string? seq) (string->list seq)) ((string? seq) (string->list seq))
(else seq)))) (else seq))))
(table 'update seq action)))) (table 'update seq (readtable:pass/blank action)))))
;;; ;;;;;;;;;;;;;;;;;;; ;;; ;;;;;;;;;;;;;;;;;;;
;;; Default readtables ;;; Default readtables
@ -293,7 +300,7 @@
(cons #\newline (readtable:return-value #f)))))) (cons #\newline (readtable:return-value #f))))))
(define readtable:top (define readtable:top
(readtable:update-many (readtable:update-many-sequence
readtable:empty readtable:empty
(cons "#t" (readtable:return-value #t)) (cons "#t" (readtable:return-value #t))
(cons "#f" (readtable:return-value #f)) (cons "#f" (readtable:return-value #f))
@ -314,7 +321,7 @@
ch))) ch)))
"test"))) "test")))
(let ((true-reader (%list->read (string->list "#tro#f")))) (let ((true-reader (%list->read (string->list "#true#f"))))
(display (list "first:" (readtable:top (true-reader 'read) #f true-reader))) (display (list "first:" (readtable:top (true-reader 'read) #f true-reader)))
(newline) (newline)
(display (list "second: " (readtable:top (true-reader 'read) #f true-reader))) (display (list "second: " (readtable:top (true-reader 'read) #f true-reader)))