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))
(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.
;;;
;;; STEP calls PROC with the same arguments.
@ -170,7 +176,8 @@
;;; Default actions
;;; ;;;;;;;;;;;;;;;
(define readtable:update-many
;;; Add multiple literal sequences to the readtable.
(define readtable:update-many-sequence
(lambda (table . pairs)
(fold (lambda (pair table)
(readtable:add-sequence table (car pair)
@ -233,10 +240,8 @@
(readtable:new new-default-action charmap)))
(empty-pass/error
(lambda ()
(readtable:pass:new
(readtable:new (readtable:error-action
"reading long name")
'()))))
(readtable:pass/blank (readtable:error-action
"reading long name"))))
(update-oldnode
(lambda (rest action)
(lambda (_ oldnode)
@ -268,13 +273,15 @@
table)))
;;; 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
(lambda (table seq action)
(let ((seq (cond
((char? seq) (list seq))
((string? seq) (string->list seq))
(else seq))))
(table 'update seq action))))
(table 'update seq (readtable:pass/blank action)))))
;;; ;;;;;;;;;;;;;;;;;;;
;;; Default readtables
@ -293,7 +300,7 @@
(cons #\newline (readtable:return-value #f))))))
(define readtable:top
(readtable:update-many
(readtable:update-many-sequence
readtable:empty
(cons "#t" (readtable:return-value #t))
(cons "#f" (readtable:return-value #f))
@ -314,7 +321,7 @@
ch)))
"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)))
(newline)
(display (list "second: " (readtable:top (true-reader 'read) #f true-reader)))