diff --git a/read.scm b/read.scm index 7158f58..a7fde06 100644 --- a/read.scm +++ b/read.scm @@ -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)")