mbutterick
/
br-parser-tools
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

*** empty log message ***

Browse Source 
original commit: 899f8afb5c8d0a51950f65a2b4d3b5200a4b0a54
tokens
Scott Owens 23 years ago
parent dc2805cf48
commit 158d4dbb07
3 changed files with 76 additions and 52 deletions
Show Stats Download Patch File Download Diff File

103
collects/parser-tools/private-yacc/input-file-parser.ss
Unescape Escape View File

@ -235,7 +235,7 @@
(terms (build-terms list-of-terms precs)) (terms (build-terms list-of-terms precs))
(non-terms (begin (non-terms (begin
(set! counter 1) (set! counter 2)
(map (lambda (non-term) (map (lambda (non-term)
(begin0 (begin0
(make-non-term non-term counter) (make-non-term non-term counter)
@ -252,8 +252,6 @@
(hash-table-put! non-term-table (gram-sym-symbol nt) nt)) (hash-table-put! non-term-table (gram-sym-symbol nt) nt))
non-terms) non-terms)
(set! counter 1)
(let* ( (let* (
;; parse-prod: syntax-object -> gram-sym vector ;; parse-prod: syntax-object -> gram-sym vector
(parse-prod (parse-prod
@ -299,41 +297,39 @@
(syntax-case prod-so (prec) (syntax-case prod-so (prec)
((prod-rhs action) ((prod-rhs action)
(let ((p (parse-prod (syntax prod-rhs)))) (let ((p (parse-prod (syntax prod-rhs))))
(begin0 (set! counter (add1 counter))
(make-prod (make-prod
nt nt
p p
counter counter
(let loop ((i (sub1 (vector-length p)))) (let loop ((i (sub1 (vector-length p))))
(if (>= i 0) (if (>= i 0)
(let ((gs (vector-ref p i))) (let ((gs (vector-ref p i)))
(if (term? gs) (if (term? gs)
(term-prec gs) (term-prec gs)
(loop (sub1 i)))) (loop (sub1 i))))
#f)) #f))
(parse-action p (syntax action))) (parse-action p (syntax action)))))
(set! counter (add1 counter)))))
((prod-rhs (prec term) action) ((prod-rhs (prec term) action)
(identifier? (syntax term)) (identifier? (syntax term))
(let ((p (parse-prod (syntax prod-rhs)))) (let ((p (parse-prod (syntax prod-rhs))))
(begin0 (set! counter (add1 counter))
(make-prod (make-prod
nt nt
p p
counter counter
(term-prec (term-prec
(hash-table-get (hash-table-get
term-table term-table
(syntax-object->datum (syntax term)) (syntax-object->datum (syntax term))
(lambda () (lambda ()
(raise-syntax-error (raise-syntax-error
'parser-production-rhs 'parser-production-rhs
(format (format
"unrecognized terminal ~a in precedence declaration" "unrecognized terminal ~a in precedence declaration"
(syntax-object->datum (syntax term))) (syntax-object->datum (syntax term)))
(syntax term))))) (syntax term)))))
(parse-action p (syntax action))) (parse-action p (syntax action)))))
(set! counter (add1 counter)))))
(_ (_
(raise-syntax-error (raise-syntax-error
'parser-production-rhs 'parser-production-rhs
@ -357,24 +353,31 @@
"A production for a non-terminal must be (non-term right-hand-side ...) with at least 1 right hand side" "A production for a non-terminal must be (non-term right-hand-side ...) with at least 1 right hand side"
prods-so)))))) prods-so))))))
(let* ((start (make-non-term 'Start 0)) (set! counter 0)
(let* ((start (make-non-term (gensym) 0))
(end-non-term (make-non-term (gensym) 1))
(prods (prods
(cons `((,(make-prod start (vector end-non-term) 0 #f #f))
(list (make-prod start ,(map
(vector (hash-table-get non-term-table start-sym) (lambda (end)
(hash-table-get term-table (car end-terms))) (set! counter (add1 counter))
0 (make-prod end-non-term
#f (vector
(datum->syntax-object (hash-table-get non-term-table start-sym)
runtime (hash-table-get term-table end))
`(lambda (x) x)))) counter
(map parse-prods-for-nt (cdr (syntax->list prods))))) #f
(datum->syntax-object
runtime
`(lambda (x) x))))
end-terms)
,@(map parse-prods-for-nt (cdr (syntax->list prods)))))
(nulls (nullable (apply append prods) (nulls (nullable (apply append prods)
(add1 (length non-terms))))) (+ 2 (length non-terms)))))
; (printf "nullable: {~a}~n~n" ; (printf "nullable: {~a}~n~n"
; (apply string-append ; (apply string-append
; (let loop ((i 0)) ; (let loop ((i 0))
; (cond ; (cond
; ((>= i (vector-length nulls)) null) ; ((>= i (vector-length nulls)) null)
@ -389,7 +392,7 @@
(list->vector prods) (list->vector prods)
(apply append prods) (apply append prods)
nulls nulls
(cons start non-terms) (cons start (cons end-non-term non-terms))
terms terms
counter (add1 counter)
end-terms)))))) end-terms))))))

13
collects/parser-tools/private-yacc/table.ss
Unescape Escape View File

@ -40,13 +40,21 @@
;; action array2d * term vector * non-term vector * kernel vector * ;; action array2d * term vector * non-term vector * kernel vector *
;; output-port -> ;; output-port ->
;; Prints out the parser given by table. ;; Prints out the parser given by table.
(define (display-parser table terms non-terms states port) (define (display-parser table terms non-terms states prods port)
(let* ((num-terms (vector-length terms)) (let* ((num-terms (vector-length terms))
(num-non-terms (vector-length non-terms)) (num-non-terms (vector-length non-terms))
(num-gram-syms (+ num-terms num-non-terms)) (num-gram-syms (+ num-terms num-non-terms))
(num-states (vector-length states)) (num-states (vector-length states))
(SR-conflicts 0) (SR-conflicts 0)
(RR-conflicts 0)) (RR-conflicts 0))
(for-each
(lambda (prod)
(fprintf port
"~a\t~a\t=\t~a~n"
(prod-index prod)
(gram-sym-symbol (prod-lhs prod))
(map gram-sym-symbol (vector->list (prod-rhs prod)))))
prods)
(let loop ((i 0)) (let loop ((i 0))
(if (< i num-states) (if (< i num-states)
(begin (begin
@ -278,7 +286,8 @@
(exn:i/o:filesystem-detail e))))] (exn:i/o:filesystem-detail e))))]
(call-with-output-file file (call-with-output-file file
(lambda (port) (lambda (port)
(display-parser table get-term get-non-term get-state port))))) (display-parser table get-term get-non-term get-state (grammar-prods g)
port)))))
(resolve-conflicts table num-states num-terms num-non-terms) (resolve-conflicts table num-states num-terms num-non-terms)
table)) table))
) )

12
collects/parser-tools/yacc.ss
Unescape Escape View File

@ -64,6 +64,18 @@
"End token must be a symbol" "End token must be a symbol"
sym))) sym)))
(syntax->list (syntax (symbols ...)))) (syntax->list (syntax (symbols ...))))
(let ((d (duplicate-list? (syntax-object->datum
(syntax (symbols ...))))))
(if d
(raise-syntax-error
'parser-end
(format "Duplicate end token definition for ~a" d)
arg)))
(if (= 0 (length (syntax->list (syntax (symbols ...)))))
(raise-syntax-error
'parser-end
"end declaration must contain at least 1 token"
arg))
(if end (if end
(raise-syntax-error #f "Multiple end declarations" stx)) (raise-syntax-error #f "Multiple end declarations" stx))
(set! end (syntax->list (syntax (symbols ...)))))) (set! end (syntax->list (syntax (symbols ...))))))

Write Preview
Loading…
Cancel
Save