*** empty log message ***

original commit: 0f0414d1c64d5ed465d2fddc358ad752a8b4209b
tokens
Scott Owens 20 years ago
parent 4f08438adf
commit 7595507209

@ -14,7 +14,7 @@
;; fix-check-syntax : (listof identifier?) (listof identifier?) (listof identifier?) ;; fix-check-syntax : (listof identifier?) (listof identifier?) (listof identifier?)
;; (union syntax? false?) syntax?) -> syntax? ;; (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)) (let* ((term-binders (get-term-list input-terms))
(get-term-binder (get-term-binder
(let ((t (make-hash-table))) (let ((t (make-hash-table)))
@ -23,7 +23,10 @@
(hash-table-put! t (syntax-e term) term)) (hash-table-put! t (syntax-e term) term))
term-binders) term-binders)
(lambda (x) (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 (rhs-list
(syntax-case prods () (syntax-case prods ()
(((_ rhs ...) ...) (((_ rhs ...) ...)
@ -36,7 +39,7 @@
tg)) tg))
input-terms)) input-terms))
((end ...) ((end ...)
(map get-term-binder end)) (map get-term-binder ends))
((start ...) ((start ...)
(map get-term-binder start)) (map get-term-binder start))
((bind ...) ((bind ...)
@ -64,7 +67,7 @@
null))) null)))
#`(when #f #`(when #f
(let ((bind void) ...) (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) (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)) (let* ((grammar (parse-input input-terms start end assocs prods src-pos))

Loading…
Cancel
Save