|
|
@ -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))
|
|
|
|