From 8e79dbf2357d9cdfcaba80f4388ecef182736d22 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 8 Aug 2011 20:40:50 -0600 Subject: [PATCH] syntax-taint repairs for problems exposed by more agressive arming of `lambda' and `#%app' original commit: 001cb75bac6166541c2fc6803b4e1061743cbce3 --- collects/mzlib/shared.rkt | 2 ++ collects/racket/package.rkt | 14 ++++++++++++-- 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/collects/mzlib/shared.rkt b/collects/mzlib/shared.rkt index 0582997..e1abe2b 100644 --- a/collects/mzlib/shared.rkt +++ b/collects/mzlib/shared.rkt @@ -9,6 +9,8 @@ (provide shared) +(define-for-syntax code-insp (current-code-inspector)) + (define undefined (letrec ([x x]) x)) (require (only-in scheme/base [cons the-cons])) diff --git a/collects/racket/package.rkt b/collects/racket/package.rkt index 73943bb..7d7aa42 100644 --- a/collects/racket/package.rkt +++ b/collects/racket/package.rkt @@ -102,6 +102,16 @@ orig orig)) +(define-for-syntax code-insp (current-code-inspector)) +(define-for-syntax (disarm* stx) + (cond + [(and (syntax? stx) + (pair? (syntax-e stx))) + (let ([stx (syntax-disarm stx code-insp)]) + (datum->syntax stx (disarm* (syntax-e stx)) stx stx))] + [(pair? stx) (cons (disarm* (car stx)) (disarm* (cdr stx)))] + [else stx])) + (define-for-syntax (do-define-package stx exp-stx) (syntax-case exp-stx () [(_ pack-id mode exports form ...) @@ -155,8 +165,8 @@ [new-bindings (make-bound-identifier-mapping)] [fixup-sub-package (lambda (renamed-exports renamed-defines def-ctxes) (lambda (stx) - (syntax-case* stx (define-syntaxes #%plain-app make-package quote-syntax - list cons #%plain-lambda) + (syntax-case* (disarm* stx) (define-syntaxes #%plain-app make-package quote-syntax + list cons #%plain-lambda) free-transformer-identifier=? [(define-syntaxes (pack-id) (#%plain-app