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

read: improper lists

This commit is contained in:
Peter McGoron 2024-09-20 22:27:17 -04:00
parent 5271cc67c6
commit 75f915d0e5
1 changed files with 40 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
read.scm
View File

@ -19,6 +19,11 @@
(load "set.scm")
(load "linked-list.scm")
;;; My text editor cannot parse Scheme's character syntax.
(define %bol #\()
(define %eol #\))
;;; ;;;;;;;;;;;;;;;;;;;;;;;;
;;; Port reader wrapper
;;; ;;;;;;;;;;;;;;;;;;;;;;;;
@ -228,7 +233,7 @@
(list readtable:exclude-from-identifiers
readtable:ASCII-whitespace)
(list readtable:exclude-from-identifiers
(list #\| #\( #\) #\' #\; #f))))
(list #\| %bol %eol #\' #\; #f))))
;;; Read an identifier starting with CHAR.
(define readtable:read-ident
@ -255,52 +260,60 @@
(readtable:empty/default readtable:skip)
(list readtable:update #\newline (readtable:return #f))))
;;; Read the end of an improper list.
(define readtable:read-improper-cdr
(lambda (table acc port)
(let ((val
(readtable:act (readtable:update table
%eol
(readtable:error
"proper list must have cdr"))
(port 'read)
#f
port)))
(acc 'set-cdr! val)
(let ((table (readtable:process
(readtable:empty/default (readtable:error
"improper list has 1 cdr"))
(list readtable:add-all-as-skip readtable:ASCII-whitespace)
(list readtable:update %eol
(lambda dummy acc)))))
(readtable:act table (port 'read) acc port)))))
;;; List reader.
;;;
;;; The reader updates the previous readtable to handle ). This means
;;; that this read table does not have to handle end-of-line, whitespace,
;;; etc.
;;;
;;; TODO: Put improper list into new function
(define readtable:read-list
(lambda (table char acc port)
(lambda (oldtable char acc port)
(let ((acc (linked-list:new))
(table (readtable:process
table
(list readtable:update #\)
oldtable
(list readtable:update %eol
(readtable:return 'end-of-list))
(list readtable:update #\.
(lambda (table char acc port)
(let ((id (readtable:read-ident
table
char
acc
#f
port)))
;; todo: list needs a car
(if (equal? id ".")
'period
(begin
(readtable:read-improper-cdr
oldtable acc port)
'end-of-list)
id)))))))
(letrec ((loop
(lambda ()
(let ((value (readtable:act table
(port 'read)
#f
acc
port)))
(cond
((eqv? value 'end-of-list) (acc 'to-list))
((eqv? value 'period)
(let ((final-value (readtable:act table
(port 'read)
#f
port)))
(acc 'set-cdr! final-value)
(let ((expect-eol (readtable:act table
(port 'read)
#f
port)))
(if (not (eqv? expect-eol 'end-of-list))
(error "found instead of end of improper list"
expect-eol)
(acc 'to-list)))))
(else (acc 'push-tail value)
(loop)))))))
(loop)))))
@ -314,8 +327,8 @@
(readtable:empty/default readtable:read-ident)
(list readtable:add-all-as-skip readtable:ASCII-whitespace)
(list readtable:update #f (readtable:return 'eof))
(list readtable:update #\( readtable:read-list)
(list readtable:update #\) (readtable:error "unbalanced list"))
(list readtable:update %bol readtable:read-list)
(list readtable:update %eol (readtable:error "unbalanced list"))
(list readtable:update #\;
(readtable:jump-discard readtable:read-to-newline)))))
@ -351,4 +364,5 @@
(read-all "x yy zz ; this is a comment\nx call/cc ")
(read-all "(a b c def (ghi j) k )")
(read-all "(a . b)")
(read-all "( a . b )")
(read-all "( a .b . c)")