*** empty log message ***

original commit: 899f8afb5c8d0a51950f65a2b4d3b5200a4b0a54
tokens
Scott Owens 23 years ago
parent dc2805cf48
commit 158d4dbb07

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

@ -40,13 +40,21 @@
;; action array2d * term vector * non-term vector * kernel vector *
;; output-port ->
;; 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))
(num-non-terms (vector-length non-terms))
(num-gram-syms (+ num-terms num-non-terms))
(num-states (vector-length states))
(SR-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))
(if (< i num-states)
(begin
@ -278,7 +286,8 @@
(exn:i/o:filesystem-detail e))))]
(call-with-output-file file
(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)
table))
)

@ -64,6 +64,18 @@
"End token must be a symbol"
sym)))
(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
(raise-syntax-error #f "Multiple end declarations" stx))
(set! end (syntax->list (syntax (symbols ...))))))

Loading…
Cancel
Save