From 7595507209007bb7f2354c8d89c3c69f5f4a62c7 Mon Sep 17 00:00:00 2001 From: Scott Owens Date: Fri, 10 Sep 2004 05:47:09 +0000 Subject: [PATCH] *** empty log message *** original commit: 0f0414d1c64d5ed465d2fddc358ad752a8b4209b --- collects/parser-tools/private-yacc/parser-builder.ss | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/collects/parser-tools/private-yacc/parser-builder.ss b/collects/parser-tools/private-yacc/parser-builder.ss index fe70e80..4d90ac6 100644 --- a/collects/parser-tools/private-yacc/parser-builder.ss +++ b/collects/parser-tools/private-yacc/parser-builder.ss @@ -14,7 +14,7 @@ ;; fix-check-syntax : (listof identifier?) (listof identifier?) (listof identifier?) ;; (union syntax? false?) syntax?) -> syntax? - (define (fix-check-syntax input-terms start end assocs prods) + (define (fix-check-syntax input-terms start ends assocs prods) (let* ((term-binders (get-term-list input-terms)) (get-term-binder (let ((t (make-hash-table))) @@ -23,7 +23,10 @@ (hash-table-put! t (syntax-e term) term)) term-binders) (lambda (x) - (hash-table-get t (syntax-e x) (lambda () x))))) + (let ((r (hash-table-get t (syntax-e x) (lambda () #f)))) + (if r + (syntax-local-introduce (datum->syntax-object r (syntax-e x) x x)) + x))))) (rhs-list (syntax-case prods () (((_ rhs ...) ...) @@ -36,7 +39,7 @@ tg)) input-terms)) ((end ...) - (map get-term-binder end)) + (map get-term-binder ends)) ((start ...) (map get-term-binder start)) ((bind ...) @@ -64,7 +67,7 @@ null))) #`(when #f (let ((bind void) ...) - (void bound ... ... term-group ... start ... end ... prec ...)))))) + (void ))))));bound ... ... term-group ... start ... end ... prec ...)))))) (define (build-parser filename src-pos suppress input-terms start end assocs prods) (let* ((grammar (parse-input input-terms start end assocs prods src-pos))