diff --git a/collects/parser-tools/lex.rkt b/collects/parser-tools/lex.rkt index 2db2ecb..f495f10 100644 --- a/collects/parser-tools/lex.rkt +++ b/collects/parser-tools/lex.rkt @@ -189,14 +189,12 @@ (normalize-definition (syntax (define-syntax name-form body-form)) #'lambda))) #`(define-syntax #,name - (let ((certifier (syntax-local-certifier)) - (func #,body)) + (let ((func #,body)) (unless (procedure? func) (raise-syntax-error 'define-lex-trans "expected a procedure as the transformer, got ~e" func)) (unless (procedure-arity-includes? func 1) (raise-syntax-error 'define-lex-trans "expected a procedure that accepts 1 argument as the transformer, got ~e" func)) - (make-lex-trans (lambda (stx) - (certifier (func stx) 'a))))))) + (make-lex-trans func))))) (_ (raise-syntax-error #f @@ -366,8 +364,8 @@ (create-unicode-abbrevs #'here) (define-lex-trans (char-set stx) - (syntax-case stx () - ((_ str) + (syntax-case stx () + ((_ str) (string? (syntax-e (syntax str))) (with-syntax (((char ...) (string->list (syntax-e (syntax str))))) (syntax (union char ...)))))) diff --git a/collects/parser-tools/parser-tools.scrbl b/collects/parser-tools/parser-tools.scrbl index d42bed3..9fe9922 100644 --- a/collects/parser-tools/parser-tools.scrbl +++ b/collects/parser-tools/parser-tools.scrbl @@ -331,6 +331,7 @@ characters, @racket[char-lower-case?] characters, etc.} _datum ...)] appears as a regular expression, it is replaced with the result of applying the transformer to the expression.} + @; ---------------------------------------- @subsection{Lexer SRE Operators} diff --git a/collects/parser-tools/private-lex/stx.rkt b/collects/parser-tools/private-lex/stx.rkt index 36976e3..37c6bc5 100644 --- a/collects/parser-tools/private-lex/stx.rkt +++ b/collects/parser-tools/private-lex/stx.rkt @@ -28,17 +28,20 @@ ((char-range-arg #'#\1 #'here) (char->integer #\1)) ((char-range-arg #'"1" #'here) (char->integer #\1))) - + (define orig-insp (current-code-inspector)) + (define (disarm stx) + (syntax-disarm stx orig-insp)) + ;; parse : syntax-object (box (list-of syntax-object)) -> s-re (see re.ss) ;; checks for errors and generates the plain s-exp form for s ;; Expands lex-abbrevs and applies lex-trans. (define (parse stx disappeared-uses) (let ((parse (lambda (s) - (parse (syntax-recertify s stx (current-inspector) 'a) + (parse (syntax-rearm s stx) disappeared-uses)))) - (syntax-case stx (repetition union intersection complement concatenation - char-range char-complement) + (syntax-case (disarm stx) (repetition union intersection complement concatenation + char-range char-complement) (_ (identifier? stx) (let ((expansion (syntax-local-value stx (lambda () #f)))) @@ -112,13 +115,11 @@ ((op form ...) (identifier? (syntax op)) (let* ((o (syntax op)) - (expansion (syntax-local-value - (syntax-recertify o stx (current-inspector) 'a) - (lambda () #f)))) + (expansion (syntax-local-value o (lambda () #f)))) (set-box! disappeared-uses (cons o (unbox disappeared-uses))) (cond ((lex-trans? expansion) - (parse ((lex-trans-f expansion) stx))) + (parse ((lex-trans-f expansion) (disarm stx)))) (expansion (raise-syntax-error 'regular-expression "not a lex-trans"