diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/reference/stx-trans.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/reference/stx-trans.scrbl index bf8416864b..e153c38eb9 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/reference/stx-trans.scrbl +++ b/pkgs/racket-pkgs/racket-doc/scribblings/reference/stx-trans.scrbl @@ -223,10 +223,11 @@ in a sub-expression, expansions stops for the sub-expression. If @racket[letrec-syntaxes+values], @racket[#%app], @racket[#%expression], @racket[#%top], and @racket[#%variable-reference] are added to @racket[stop-ids]. If -@racket[#%app], @racket[#%top], or @racket[#%datum] appears in -@racket[stop-ids], then application, top-level variable reference, and +@racket[#%app] or @racket[#%datum] appears in +@racket[stop-ids], then application and literal data expressions without the respective explicit form are not -wrapped with the explicit form. If @racket[stop-ids] is @racket[#f] +wrapped with the explicit form, and @racket[#%top] wrappers are +never added (even with an empty @racket[stop-ids] list). If @racket[stop-ids] is @racket[#f] instead of a list, then @racket[stx] is expanded only as long as the outermost form of @racket[stx] is a macro (i.e., expansion does not proceed to sub-expressions). A fully expanded form can include the @@ -290,7 +291,11 @@ generated value onto that list. fully)])) (show 1) -]} +] + +@history[#:changed "6.0.1.3" @elem{Changed treatment of @racket[#%top] + so that it is never introduced as + an explicit wrapper.}]} @defproc[(syntax-local-expand-expression [stx syntax?]) diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/reference/syntax.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/reference/syntax.scrbl index 2c23f8cc41..b008cdb8bb 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/reference/syntax.scrbl +++ b/pkgs/racket-pkgs/racket-doc/scribblings/reference/syntax.scrbl @@ -1614,16 +1614,18 @@ x @defform[(#%top . id)]{ -Refers to a module-level or top-level definition that could bind -@racket[id], even if @racket[id] has a local binding in its context. +Refers to a module-level or top-level definition. If @racket[id] has a +local binding in its context, then @racket[(#%top . id)] refers to a +top-level definition, but a reference to a top-level definition is +disallowed within a module. Within a @racket[module] form, @racket[(#%top . id)] expands to just @racket[id]---with the obligation that @racket[id] is defined within -the module. At @tech{phase level} 0, @racket[(#%top . id)] is an -immediate syntax error if @racket[id] is not bound. At @tech{phase -level} 1 and higher, a syntax error is reported if @racket[id] is not -defined at the corresponding phase by the end of @racket[module]-body -@tech{partial expansion}. +the module and has no local binding in its context. At @tech{phase +level} 0, @racket[(#%top . id)] is an immediate syntax error if +@racket[id] is not bound. At @tech{phase level} 1 and higher, a syntax +error is reported if @racket[id] is not defined at the corresponding +phase by the end of @racket[module]-body @tech{partial expansion}. See also @secref["expand-steps"] for information on how the expander introduces @racketidfont{#%top} identifiers. diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/macro.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/macro.rktl index 6bba645745..c7220d6e85 100644 --- a/pkgs/racket-pkgs/racket-test/tests/racket/macro.rktl +++ b/pkgs/racket-pkgs/racket-test/tests/racket/macro.rktl @@ -1031,6 +1031,60 @@ (eval `(require 'm))) (test "2\n" get-output-string o)) +;; ---------------------------------------- +;; Lifting should not introduce `#%top` around +;; the reference to the lifted identifier: + +(module lifting-doesnt-introduce-top-wrapper racket + ;; do the lifting + (define-syntax (m stx) + (syntax-local-lift-expression #'(+ 1 1))) + + ;; catch the lift, try to put definitions in a let + (define-syntax (catch stx) + (syntax-case stx () + [(_ body) + (syntax-case (local-expand/capture-lifts #'body (syntax-local-context) null) + (define-values begin) + [(begin (define-values (x ...) e ...) ... exp) + #'(let () (define-values (x ...) e ...) ... exp)])])) + + (define z (catch (+ 1 (m)))) + + (provide z)) + +(test 3 dynamic-require ''lifting-doesnt-introduce-top-wrapper 'z) + + +(parameterize ([current-namespace (make-base-namespace)]) + (eval '(require (for-syntax racket/base))) + (eval '(define-syntax (m stx) + (syntax-local-lift-expression #'(+ 1 1)))) + (eval '(define-syntax (catch stx) + (syntax-case stx () + [(_ body) + (syntax-case (local-expand/capture-lifts #'body (syntax-local-context) null) + (define-values begin) + [(begin (define-values (x ...) e ...) ... exp) + #'(let () (define-values (x ...) e ...) ... exp)])]))) + (test 3 eval '(catch (+ 1 (m))))) + +(let-syntax ([m (lambda (stx) + (define e (local-expand #'nonsuch 'expression null)) + (unless (identifier? e) + (error 'test "bad expansion: ~e" e)) + #'(void))]) + (m)) +(let-syntax ([m (lambda (stx) + (define e (local-expand #'(#%top . nonsuch) 'expression null)) + (syntax-case e (#%top) + [(#%top . id) + (identifier? #'id) + #'(void)] + [else + (error 'test "bad expansion: ~e" e)]))]) + (m)) + ;; ---------------------------------------- (report-errs) diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/syntax.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/syntax.rktl index cabb689011..38a355b48a 100644 --- a/pkgs/racket-pkgs/racket-test/tests/racket/syntax.rktl +++ b/pkgs/racket-pkgs/racket-test/tests/racket/syntax.rktl @@ -1288,6 +1288,16 @@ (define x 5) (test 5 '#%top (#%top . x)) +(syntax-test #'(module m racket/base + (define x 1) + (let ([x 2]) (#%top . x)))) + +(module ok-top-reference-within-module racket/base + (define x 1) + (define z (let ([y 2]) (#%top . x))) + (provide z)) +(test 1 dynamic-require ''ok-top-reference-within-module 'z) + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Tests related to bytecode optimizer. ;; The (if (let ([x M]) (if x x N)) ...) diff --git a/racket/src/racket/src/compile.c b/racket/src/racket/src/compile.c index 361f104de5..4b769001dd 100644 --- a/racket/src/racket/src/compile.c +++ b/racket/src/racket/src/compile.c @@ -4815,9 +4815,15 @@ scheme_compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env, } return f(form, env, rec, drec); } else { - name = scheme_stx_taint_disarm(form, NULL); - form = scheme_datum_to_syntax(scheme_make_pair(stx, name), form, form, 0, 2); - SCHEME_EXPAND_OBSERVE_TAG(rec[drec].observer, form); + if (!rec[drec].comp + && (rec[drec].depth == -2) /* local-expand */ + && SAME_OBJ(SCHEME_STX_VAL(stx), top_symbol)) { + rec[drec].pre_unwrapped = 1; + } else { + name = scheme_stx_taint_disarm(form, NULL); + form = scheme_datum_to_syntax(scheme_make_pair(stx, name), form, form, 0, 2); + SCHEME_EXPAND_OBSERVE_TAG(rec[drec].observer, form); + } if (SAME_TYPE(SCHEME_TYPE(var), scheme_syntax_compiler_type)) { if (rec[drec].comp) { @@ -5329,7 +5335,7 @@ top_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, SCHEME_EXPAND_OBSERVE_PRIM_TOP(erec[drec].observer); c = check_top(form, env, erec, drec, &need_bound_check); - if (need_bound_check) + if (env->genv->module) return c; /* strip `#%top' prefix */ return form;