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:
parent
ccda0e4abb
commit
b25a2b83ba
|
@ -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?])
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)) ...)
|
||||
|
|
|
@ -4814,10 +4814,16 @@ scheme_compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
|
|||
((Scheme_Stx *)quick_stx)->taints = NULL;
|
||||
}
|
||||
return f(form, env, rec, drec);
|
||||
} else {
|
||||
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;
|
||||
|
|
Loading…
Reference in New Issue
Block a user