readtable: add lists
This commit is contained in:
parent
ac28546a29
commit
5271cc67c6
|
|
@ -19,7 +19,7 @@ designed to be used by a severely limited Scheme interpreter, which
|
|||
* has fixnums only
|
||||
* only uses immutable strings
|
||||
* does not use "load" recursively
|
||||
* uses R3RS essential procedures only (with some exceptions)
|
||||
* uses R3RS essential procedures/syntax only (with some exceptions)
|
||||
|
||||
The goal is to have the compiler run under the MiniScheme in ``miniscm``
|
||||
in DOS, and then run in GLLV to compile itself.
|
||||
|
|
|
|||
91
read.scm
91
read.scm
|
|
@ -17,6 +17,7 @@
|
|||
(load "chez-compat.scm")
|
||||
(load "util.scm")
|
||||
(load "set.scm")
|
||||
(load "linked-list.scm")
|
||||
|
||||
;;; ;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Port reader wrapper
|
||||
|
|
@ -159,6 +160,12 @@
|
|||
;;; Default readtables
|
||||
;;; ;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;; Return an error.
|
||||
(define readtable:error
|
||||
(lambda emsg
|
||||
(lambda tablemsg
|
||||
(apply error tablemsg emsg))))
|
||||
|
||||
;;; Discard the current character and continue reading the readtable.
|
||||
(define readtable:skip
|
||||
(lambda (table char acc port)
|
||||
|
|
@ -178,6 +185,12 @@
|
|||
(readtable:act newtable (port 'read) '() port)
|
||||
(readtable:act oldtable (port 'read) acc port))))
|
||||
|
||||
;;; Jump to a new readtable with the same characters.
|
||||
(define readtable:jump
|
||||
(lambda (newtable)
|
||||
(lambda (oldtable char acc port)
|
||||
(readtable:act newtable char acc port))))
|
||||
|
||||
;;; Push back CHAR and return ACC.
|
||||
(define readtable:return-acc-keep-char
|
||||
(lambda (table char acc port)
|
||||
|
|
@ -185,9 +198,10 @@
|
|||
acc))
|
||||
|
||||
;;; Push CHAR to ACC and continue reading from TABLE.
|
||||
(define readtable:push-acc
|
||||
(define readtable:push-char
|
||||
(lambda (table char acc port)
|
||||
(readtable:act table (port 'read) (cons char acc) port)))
|
||||
(acc 'push-tail char)
|
||||
(readtable:act table (port 'read) acc port)))
|
||||
|
||||
;;; Define a readtable that constructs an identifier by accepting all
|
||||
;;; characters that are not listed.
|
||||
|
|
@ -210,7 +224,7 @@
|
|||
;;; Readtable for identifiers.
|
||||
(define readtable:identifier
|
||||
(readtable:process
|
||||
(readtable:empty/default readtable:push-acc)
|
||||
(readtable:empty/default readtable:push-char)
|
||||
(list readtable:exclude-from-identifiers
|
||||
readtable:ASCII-whitespace)
|
||||
(list readtable:exclude-from-identifiers
|
||||
|
|
@ -219,8 +233,12 @@
|
|||
;;; Read an identifier starting with CHAR.
|
||||
(define readtable:read-ident
|
||||
(lambda (table char acc port)
|
||||
(reverse (readtable:act readtable:identifier
|
||||
(port 'read) (list char) port))))
|
||||
(let ((lst (linked-list:new)))
|
||||
(lst 'push char)
|
||||
(list->string
|
||||
((readtable:act readtable:identifier
|
||||
(port 'read) lst port)
|
||||
'to-list)))))
|
||||
|
||||
;;; Add all chars in TO-SKIP to TABLE as skipped characters. Used for
|
||||
;;; whitespace.
|
||||
|
|
@ -237,14 +255,69 @@
|
|||
(readtable:empty/default readtable:skip)
|
||||
(list readtable:update #\newline (readtable:return #f))))
|
||||
|
||||
;;; 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)
|
||||
(let ((acc (linked-list:new))
|
||||
(table (readtable:process
|
||||
table
|
||||
(list readtable:update #\)
|
||||
(readtable:return 'end-of-list))
|
||||
(list readtable:update #\.
|
||||
(lambda (table char acc port)
|
||||
(let ((id (readtable:read-ident
|
||||
table
|
||||
char
|
||||
acc
|
||||
port)))
|
||||
(if (equal? id ".")
|
||||
'period
|
||||
id)))))))
|
||||
(letrec ((loop
|
||||
(lambda ()
|
||||
(let ((value (readtable:act table
|
||||
(port 'read)
|
||||
#f
|
||||
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)))))
|
||||
|
||||
;;; Toplevel reader.
|
||||
;;; This is defined as a function so that it dynamically loads each
|
||||
;;; sub-readtable.
|
||||
(define readtable:top
|
||||
(lambda ()
|
||||
(readtable:process
|
||||
(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 #\;
|
||||
(readtable:jump-discard readtable:read-to-newline))))
|
||||
(readtable:jump-discard readtable:read-to-newline)))))
|
||||
|
||||
;;; ;;;;;;;;;;;
|
||||
;;; Test reader
|
||||
|
|
@ -268,7 +341,7 @@
|
|||
(if (not (reader 'peek))
|
||||
#t
|
||||
(let ((value (readtable:act
|
||||
readtable:top (reader 'read)
|
||||
(readtable:top) (reader 'read)
|
||||
#f
|
||||
reader)))
|
||||
(display (list "return" value))
|
||||
|
|
@ -277,5 +350,5 @@
|
|||
(loop)))))
|
||||
|
||||
(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)")
|
||||
|
|
|
|||
Loading…
Reference in New Issue