From 158d4dbb07469b4a52293f520a2940a1f420033b Mon Sep 17 00:00:00 2001 From: Scott Owens Date: Mon, 22 Oct 2001 21:53:02 +0000 Subject: [PATCH] *** empty log message *** original commit: 899f8afb5c8d0a51950f65a2b4d3b5200a4b0a54 --- .../private-yacc/input-file-parser.ss | 103 +++++++++--------- collects/parser-tools/private-yacc/table.ss | 13 ++- collects/parser-tools/yacc.ss | 12 ++ 3 files changed, 76 insertions(+), 52 deletions(-) diff --git a/collects/parser-tools/private-yacc/input-file-parser.ss b/collects/parser-tools/private-yacc/input-file-parser.ss index df053b8..c0c4fa7 100644 --- a/collects/parser-tools/private-yacc/input-file-parser.ss +++ b/collects/parser-tools/private-yacc/input-file-parser.ss @@ -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,41 +297,39 @@ (syntax-case prod-so (prec) ((prod-rhs action) (let ((p (parse-prod (syntax prod-rhs)))) - (begin0 - (make-prod - nt - p - counter - (let loop ((i (sub1 (vector-length p)))) - (if (>= i 0) - (let ((gs (vector-ref p i))) - (if (term? gs) - (term-prec gs) - (loop (sub1 i)))) - #f)) - (parse-action p (syntax action))) - (set! counter (add1 counter))))) + (set! counter (add1 counter)) + (make-prod + nt + p + counter + (let loop ((i (sub1 (vector-length p)))) + (if (>= i 0) + (let ((gs (vector-ref p i))) + (if (term? gs) + (term-prec gs) + (loop (sub1 i)))) + #f)) + (parse-action p (syntax action))))) ((prod-rhs (prec term) action) (identifier? (syntax term)) (let ((p (parse-prod (syntax prod-rhs)))) - (begin0 - (make-prod - nt - p - counter - (term-prec - (hash-table-get - term-table - (syntax-object->datum (syntax term)) - (lambda () - (raise-syntax-error - 'parser-production-rhs - (format - "unrecognized terminal ~a in precedence declaration" - (syntax-object->datum (syntax term))) - (syntax term))))) - (parse-action p (syntax action))) - (set! counter (add1 counter))))) + (set! counter (add1 counter)) + (make-prod + nt + p + counter + (term-prec + (hash-table-get + term-table + (syntax-object->datum (syntax term)) + (lambda () + (raise-syntax-error + 'parser-production-rhs + (format + "unrecognized terminal ~a in precedence declaration" + (syntax-object->datum (syntax term))) + (syntax term))))) + (parse-action p (syntax action))))) (_ (raise-syntax-error '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" 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 - #f - (datum->syntax-object - runtime - `(lambda (x) x)))) - (map parse-prods-for-nt (cdr (syntax->list prods))))) + `((,(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)))) + 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" -; (apply string-append +; (apply string-append ; (let loop ((i 0)) ; (cond ; ((>= i (vector-length nulls)) null) @@ -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)))))) diff --git a/collects/parser-tools/private-yacc/table.ss b/collects/parser-tools/private-yacc/table.ss index 528a086..493d6ec 100644 --- a/collects/parser-tools/private-yacc/table.ss +++ b/collects/parser-tools/private-yacc/table.ss @@ -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)) ) diff --git a/collects/parser-tools/yacc.ss b/collects/parser-tools/yacc.ss index 262fd0a..de9c1a9 100644 --- a/collects/parser-tools/yacc.ss +++ b/collects/parser-tools/yacc.ss @@ -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 ...))))))