reduced size of parser, and added two helpers for reading and
recording position.
This commit is contained in:
parent
2c98be442a
commit
0aa846ba78
|
@ -994,6 +994,33 @@
|
||||||
[(char-whitespace? c) (tokenize/1 p)]
|
[(char-whitespace? c) (tokenize/1 p)]
|
||||||
[else (tokenize/c c 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
|
(define tokenize-script-initial
|
||||||
(lambda (p)
|
(lambda (p)
|
||||||
(let ([c (read-char p)])
|
(let ([c (read-char p)])
|
||||||
|
@ -1021,10 +1048,39 @@
|
||||||
[(char-whitespace? c) (tokenize/1 p)]
|
[(char-whitespace? c) (tokenize/1 p)]
|
||||||
[else (tokenize/c c 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?))
|
(define-struct loc (value set?))
|
||||||
(module (read-expr read-expr-script-initial)
|
(module (read-expr read-expr-script-initial)
|
||||||
(define read-list-rest
|
(define read-list
|
||||||
(lambda (p locs k end mis)
|
(lambda (p locs k end mis init?)
|
||||||
(let ([t (tokenize/1 p)])
|
(let ([t (tokenize/1 p)])
|
||||||
(cond
|
(cond
|
||||||
[(eof-object? t)
|
[(eof-object? t)
|
||||||
|
@ -1033,6 +1089,8 @@
|
||||||
[(eq? t mis)
|
[(eq? t mis)
|
||||||
(die/p-1 p 'read "paren mismatch")]
|
(die/p-1 p 'read "paren mismatch")]
|
||||||
[(eq? t 'dot)
|
[(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-values ([(d locs k) (read-expr p locs k)])
|
||||||
(let ([t (tokenize/1 p)])
|
(let ([t (tokenize/1 p)])
|
||||||
(cond
|
(cond
|
||||||
|
@ -1046,26 +1104,7 @@
|
||||||
(format "expecting ~a, got ~a" end t))])))]
|
(format "expecting ~a, got ~a" end t))])))]
|
||||||
[else
|
[else
|
||||||
(let-values ([(a locs k) (parse-token p locs k t)])
|
(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)])
|
(let ([x (cons a d)])
|
||||||
(values x locs
|
(values x locs
|
||||||
(if (or (loc? a) (loc? d))
|
(if (or (loc? a) (loc? d))
|
||||||
|
@ -1147,8 +1186,8 @@
|
||||||
(lambda (p locs k t)
|
(lambda (p locs k t)
|
||||||
(cond
|
(cond
|
||||||
[(eof-object? t) (values (eof-object) locs k)]
|
[(eof-object? t) (values (eof-object) locs k)]
|
||||||
[(eq? t 'lparen) (read-list-init p locs k 'rparen 'rbrack)]
|
[(eq? t 'lparen) (read-list p locs k 'rparen 'rbrack #t)]
|
||||||
[(eq? t 'lbrack) (read-list-init p locs k 'rbrack 'rparen)]
|
[(eq? t 'lbrack) (read-list p locs k 'rbrack 'rparen #t)]
|
||||||
[(eq? t 'vparen) (read-vector p locs k 0 '())]
|
[(eq? t 'vparen) (read-vector p locs k 0 '())]
|
||||||
[(eq? t 'vu8) (read-bytevector p locs k 0 '())]
|
[(eq? t 'vu8) (read-bytevector p locs k 0 '())]
|
||||||
[(pair? t)
|
[(pair? t)
|
||||||
|
@ -1212,6 +1251,9 @@
|
||||||
;;; - expression is a list/vector/id/whathaveyou that
|
;;; - expression is a list/vector/id/whathaveyou that
|
||||||
;;; may contain further annotations.
|
;;; may contain further annotations.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(define reduce-loc!
|
(define reduce-loc!
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(let ([loc (cdr x)])
|
(let ([loc (cdr x)])
|
||||||
|
|
|
@ -1 +1 @@
|
||||||
1263
|
1264
|
||||||
|
|
Loading…
Reference in New Issue