conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

reduced size of parser, and added two helpers for reading and 

recording position.
This commit is contained in:
Abdulaziz Ghuloum 2007-12-18 23:07:57 -05:00
parent 2c98be442a
commit 0aa846ba78
2 changed files with 68 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

90
scheme/ikarus.reader.ss
View File

@ -994,6 +994,33 @@
[(char-whitespace? c) (tokenize/1 p)]
[else (tokenize/c c p)]))))
(define tokenize/1+pos
(lambda (p)
(let ([pos (input-port-byte-position p)])
(let ([c (read-char p)])
(cond
[(eof-object? c) (values pos (eof-object))]
[(eqv? c #\;)
(skip-comment p)
(tokenize/1+pos p)]
[(eqv? c #\#)
(let ([pos (input-port-byte-position p)])
(let ([c (read-char p)])
(cond
[(eof-object? c)
(die/p p 'tokenize "invalid eof after #")]
[(eqv? c #\;)
(my-read p) ; skip s-expr
(tokenize/1+pos p)]
[(eqv? c #\|)
(multiline-comment p)
(tokenize/1+pos p)]
[else
(values (tokenize-hash/c c p) pos)])))]
[(char-whitespace? c) (tokenize/1+pos p)]
[else
(values (tokenize/c c p) pos)])))))
(define tokenize-script-initial
(lambda (p)
(let ([c (read-char p)])
@ -1021,10 +1048,39 @@
[(char-whitespace? c) (tokenize/1 p)]
[else (tokenize/c c p)]))))
(define tokenize-script-initial+pos
(lambda (p)
(let ([pos (input-port-byte-position p)])
(let ([c (read-char p)])
(cond
[(eof-object? c) (values (eof-object) p)]
[(eqv? c #\;)
(skip-comment p)
(tokenize/1+pos p)]
[(eqv? c #\#)
(let ([pos (input-port-byte-position p)])
(let ([c (read-char p)])
(cond
[(eof-object? c)
(die/p p 'tokenize "invalid eof after #")]
[(eqv? c #\!)
(skip-comment p)
(tokenize/1+pos p)]
[(eqv? c #\;)
(my-read p) ; skip s-expr
(tokenize/1+pos p)]
[(eqv? c #\|)
(multiline-comment p)
(tokenize/1+pos p)]
[else
(values (tokenize-hash/c c p) pos)])))]
[(char-whitespace? c) (tokenize/1+pos p)]
[else (values (tokenize/c c p) pos)])))))
(define-struct loc (value set?))
(module (read-expr read-expr-script-initial)
(define read-list-rest
(lambda (p locs k end mis)
(define read-list
(lambda (p locs k end mis init?)
(let ([t (tokenize/1 p)])
(cond
[(eof-object? t)
@ -1033,6 +1089,8 @@
[(eq? t mis)
(die/p-1 p 'read "paren mismatch")]
[(eq? t 'dot)
(when init?
(die/p-1 p 'read "invalid dot while reading list"))
(let-values ([(d locs k) (read-expr p locs k)])
(let ([t (tokenize/1 p)])
(cond
@ -1046,31 +1104,12 @@
(format "expecting ~a, got ~a" end t))])))]
[else
(let-values ([(a locs k) (parse-token p locs k t)])
(let-values ([(d locs k) (read-list-rest p locs k end mis)])
(let-values ([(d locs k) (read-list p locs k end mis #f)])
(let ([x (cons a d)])
(values x locs
(if (or (loc? a) (loc? d))
(extend-k-pair x k)
k)))))]))))
(define read-list-init
(lambda (p locs k end mis)
(let ([t (tokenize/1 p)])
(cond
[(eof-object? t)
(die/p p 'read "end of file encountered while reading list")]
[(eq? t end) (values '() locs k)]
[(eq? t mis)
(die/p-1 p 'read "paren mismatch")]
[(eq? t 'dot)
(die/p-1 p 'read "invalid dot while reading list")]
[else
(let-values ([(a locs k) (parse-token p locs k t)])
(let-values ([(d locs k) (read-list-rest p locs k end mis)])
(let ([x (cons a d)])
(values x locs
(if (or (loc? a) (loc? d))
(extend-k-pair x k)
k)))))]))))
(define extend-k-pair
(lambda (x k)
(lambda ()
@ -1147,8 +1186,8 @@
(lambda (p locs k t)
(cond
[(eof-object? t) (values (eof-object) locs k)]
[(eq? t 'lparen) (read-list-init p locs k 'rparen 'rbrack)]
[(eq? t 'lbrack) (read-list-init p locs k 'rbrack 'rparen)]
[(eq? t 'lparen) (read-list p locs k 'rparen 'rbrack #t)]
[(eq? t 'lbrack) (read-list p locs k 'rbrack 'rparen #t)]
[(eq? t 'vparen) (read-vector p locs k 0 '())]
[(eq? t 'vu8) (read-bytevector p locs k 0 '())]
[(pair? t)
@ -1212,6 +1251,9 @@
;;; - expression is a list/vector/id/whathaveyou that
;;; may contain further annotations.
(define reduce-loc!
(lambda (x)
(let ([loc (cdr x)])

2
scheme/last-revision
View File

@ -1 +1 @@
1263
1264