remove syntax certificates; add syntax taints

original commit: 1160d3df629ce65eb8fe9ebea2c33b8d4000ea50
tokens
Matthew Flatt 13 years ago
parent 616c2649fd
commit f8081d0175

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

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

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

Loading…
Cancel
Save