*** empty log message ***

original commit: bbfedc088f39101e2cdb178dccfe29494107c596
tokens
Scott Owens 21 years ago
parent 71caee98aa
commit 98ddb01840

@ -18,7 +18,7 @@
so so
so))) so)))
(define (fix-check-syntax start terms prods precs ends) (define (fix-check-syntax start term-groups prods precs ends)
(syntax-case prods () (syntax-case prods ()
((_ (bind ((bound ...) x ...) ...) ...) ((_ (bind ((bound ...) x ...) ...) ...)
(let ((binds (syntax->list (syntax (bind ...)))) (let ((binds (syntax->list (syntax (bind ...))))
@ -30,7 +30,14 @@
append append
(map syntax->list (map syntax->list
(syntax->list (syntax (((bound ...) ...) ...))))))))) (syntax->list (syntax (((bound ...) ...) ...)))))))))
(terms (get-term-list terms)) (terms (get-term-list term-groups))
(term-group-stx
(map (lambda (tg)
(syntax-property
(datum->syntax-object tg #f)
'disappeared-use
tg))
(syntax->list term-groups)))
(precs (if precs (precs (if precs
(syntax-case precs () (syntax-case precs ()
((_ (__ term ...) ...) ((_ (__ term ...) ...)
@ -39,7 +46,7 @@
`(if #f (let ,(map (lambda (bind) `(if #f (let ,(map (lambda (bind)
`(,(strip bind) void)) `(,(strip bind) void))
(append terms binds)) (append terms binds))
(void ,@(append ends precs (map strip bounds))))))))) (void ,@(append ends precs term-group-stx (map strip bounds)))))))))
(define (build-parser filename src-pos suppress input-terms start end assocs prods runtime) (define (build-parser filename src-pos suppress input-terms start end assocs prods runtime)
(let* ((grammar (parse-input start end input-terms assocs prods runtime src-pos)) (let* ((grammar (parse-input start end input-terms assocs prods runtime src-pos))

Loading…
Cancel
Save