*** empty log message ***

original commit: 27620ae4971368a800168f028b47d844efd615ef

collects/parser-tools/lex.ss

@@ -164,7 +164,10 @@
       ((_ name-form body-form)
        (let-values (((name body)
                      (normalize-definition (syntax (define-syntax name-form body-form)) #'lambda)))
-         #`(define-syntax #,name (make-lex-trans #,body))))
+         #`(define-syntax #,name 
+             (let ((certifier (syntax-local-certifier)))
+               (make-lex-trans (lambda (stx)
+                                 (certifier (#,body stx) 'a)))))))
       (_
        (raise-syntax-error
         #f

collects/parser-tools/private-lex/stx.ss

@@ -34,8 +34,9 @@
   ;; Expands lex-abbrevs and applies lex-trans.
   (define (parse stx disappeared-uses)
     (let ((parse
-           (lambda (stx)
+           (lambda (s)
-             (parse stx disappeared-uses))))
+             (parse (syntax-recertify s stx (current-inspector) 'a) 
+                    disappeared-uses))))
     (syntax-case stx (repetition union intersection complement concatenation
                       char-range char-complement)
       (_
@@ -111,7 +112,9 @@
        ((op form ...)
         (identifier? (syntax op))
         (let* ((o (syntax op))
-               (expansion (syntax-local-value o (lambda () #f))))
+               (expansion (syntax-local-value 
+                           (syntax-recertify o stx (current-inspector) 'a) 
+                           (lambda () #f))))
           (set-box! disappeared-uses (cons o (unbox disappeared-uses)))
           (cond
             ((lex-trans? expansion)

collects/parser-tools/private-lex/token.ss

@@ -73,7 +73,7 @@
                          #`(define (#,(make-ctor-name n) x)
                              (make-token '#,n x))))
                    (syntax->list (syntax (token ...))))
-               (define-syntax marked-token #f) ...))))
+               (define marked-token #f) ...))))
         ((_ ...)
          (raise-syntax-error 
           #f

collects/parser-tools/private-yacc/parser-builder.ss

@@ -12,14 +12,6 @@
                   (listof identifier?) (union syntax? false?) syntax?) . ->* .
                  (any? any? any? any?))))
   
-  (define (strip so)
-    (syntax-local-introduce
-     (datum->syntax-object
-      #f
-      (syntax-object->datum so)
-      so
-      so)))
-  
   ;; fix-check-syntax : (listof identifier?) (listof identifier?) (listof identifier?)
   ;;                    (union syntax? false?) syntax?) -> syntax?
   (define (fix-check-syntax input-terms start end assocs prods)
@@ -36,8 +28,7 @@
             (syntax-case prods ()
               (((_ rhs ...) ...)
                (syntax->list (syntax (rhs ... ...)))))))
-      (with-syntax (((tmp ...) term-binders)
+      (with-syntax (((term-group ...)
-                    ((term-group ...)
                      (map (lambda (tg)
                             (syntax-property
                              (datum->syntax-object tg #f)
@@ -46,9 +37,12 @@
                           input-terms))
                     ((end ...)
                      (map get-term-binder end))
+                    ((start ...)
+                     (map get-term-binder start))
                     ((bind ...)
                      (syntax-case prods ()
-                       (((bind _ ...) ...) (syntax->list (syntax (bind ...))))))
+                       (((bind _ ...) ...)
+                        (syntax->list (syntax (bind ...))))))
                     (((bound ...) ...)
                      (map
                       (lambda (rhs)
@@ -69,8 +63,8 @@
                                  (syntax->list (syntax (term ... ...))))))
                          null)))
         #`(when #f
-                 (let ((bind void) ... (tmp void) ...)
+            (let ((bind void) ...)
-                   (void bound ... ... term-group ... 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))