The implementation of #%top within a module has, for a while,

required that the identifier wrapped by `#%top` not have a local
binding. Change the documentation to match the implementation in that
way. (Since local binding in an identifier's lexical information
contributes to its identity as a top-level binding, that specification
of `#%top` would make sense everywhere, but I've left the top level
alone for backward compatibility.)

Also, change `local-expand` to never introduct `#%top`
wrappers. That's a little more consistent with what `#%top` has
evolved to mean, and it specifically works better with
`local-expand/capture-lifts`.

Closes PR 14635 and PR 14654
This commit is contained in:
Matthew Flatt 2014-07-25 08:57:07 +01:00
parent ccda0e4abb
commit b25a2b83ba
5 changed files with 92 additions and 15 deletions

View File

@ -223,10 +223,11 @@ in a sub-expression, expansions stops for the sub-expression. If
@racket[letrec-syntaxes+values], @racket[#%app], @racket[letrec-syntaxes+values], @racket[#%app],
@racket[#%expression], @racket[#%top], and @racket[#%expression], @racket[#%top], and
@racket[#%variable-reference] are added to @racket[stop-ids]. If @racket[#%variable-reference] are added to @racket[stop-ids]. If
@racket[#%app], @racket[#%top], or @racket[#%datum] appears in @racket[#%app] or @racket[#%datum] appears in
@racket[stop-ids], then application, top-level variable reference, and @racket[stop-ids], then application and
literal data expressions without the respective explicit form are not 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 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 outermost form of @racket[stx] is a macro (i.e., expansion does not
proceed to sub-expressions). A fully expanded form can include the proceed to sub-expressions). A fully expanded form can include the
@ -290,7 +291,11 @@ generated value onto that list.
fully)])) fully)]))
(show 1) (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?]) @defproc[(syntax-local-expand-expression [stx syntax?])

View File

@ -1614,16 +1614,18 @@ x
@defform[(#%top . id)]{ @defform[(#%top . id)]{
Refers to a module-level or top-level definition that could bind Refers to a module-level or top-level definition. If @racket[id] has a
@racket[id], even if @racket[id] has a local binding in its context. 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 Within a @racket[module] form, @racket[(#%top . id)] expands to just
@racket[id]---with the obligation that @racket[id] is defined within @racket[id]---with the obligation that @racket[id] is defined within
the module. At @tech{phase level} 0, @racket[(#%top . id)] is an the module and has no local binding in its context. At @tech{phase
immediate syntax error if @racket[id] is not bound. At @tech{phase level} 0, @racket[(#%top . id)] is an immediate syntax error if
level} 1 and higher, a syntax error is reported if @racket[id] is not @racket[id] is not bound. At @tech{phase level} 1 and higher, a syntax
defined at the corresponding phase by the end of @racket[module]-body error is reported if @racket[id] is not defined at the corresponding
@tech{partial expansion}. phase by the end of @racket[module]-body @tech{partial expansion}.
See also @secref["expand-steps"] for information on how the expander See also @secref["expand-steps"] for information on how the expander
introduces @racketidfont{#%top} identifiers. introduces @racketidfont{#%top} identifiers.

View File

@ -1031,6 +1031,60 @@
(eval `(require 'm))) (eval `(require 'm)))
(test "2\n" get-output-string o)) (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) (report-errs)

View File

@ -1288,6 +1288,16 @@
(define x 5) (define x 5)
(test 5 '#%top (#%top . x)) (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. ;; Tests related to bytecode optimizer.
;; The (if (let ([x M]) (if x x N)) ...) ;; The (if (let ([x M]) (if x x N)) ...)

View File

@ -4815,9 +4815,15 @@ scheme_compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
} }
return f(form, env, rec, drec); return f(form, env, rec, drec);
} else { } else {
name = scheme_stx_taint_disarm(form, NULL); if (!rec[drec].comp
form = scheme_datum_to_syntax(scheme_make_pair(stx, name), form, form, 0, 2); && (rec[drec].depth == -2) /* local-expand */
SCHEME_EXPAND_OBSERVE_TAG(rec[drec].observer, form); && 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 (SAME_TYPE(SCHEME_TYPE(var), scheme_syntax_compiler_type)) {
if (rec[drec].comp) { 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); SCHEME_EXPAND_OBSERVE_PRIM_TOP(erec[drec].observer);
c = check_top(form, env, erec, drec, &need_bound_check); c = check_top(form, env, erec, drec, &need_bound_check);
if (need_bound_check) if (env->genv->module)
return c; /* strip `#%top' prefix */ return c; /* strip `#%top' prefix */
return form; return form;