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