From 6ea9e963c4c25948f94f9f9406df604750833a1c Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 13 Jan 2016 07:44:31 -0700 Subject: [PATCH] add context properties to a `module` expansion Add 'module-body-inside-context, 'module-body-outside-context, and 'module-body-context-simple? properties to the expansion of a `module` form. These properties expose scopes that are used by `module->namespace` and taht appear in marshaled bytecode. --- .../scribblings/raco/zo-struct.scrbl | 17 +++--- .../scribblings/reference/stx-expand.scrbl | 38 +++++++++++++ .../scribblings/reference/syntax-model.scrbl | 23 ++++++-- .../racket-test-core/tests/racket/module.rktl | 29 ++++++++++ racket/src/racket/src/module.c | 54 +++++++++++++++++-- 5 files changed, 146 insertions(+), 15 deletions(-) diff --git a/pkgs/racket-doc/scribblings/raco/zo-struct.scrbl b/pkgs/racket-doc/scribblings/raco/zo-struct.scrbl index d0f86d547f..c3a69d40f3 100644 --- a/pkgs/racket-doc/scribblings/raco/zo-struct.scrbl +++ b/pkgs/racket-doc/scribblings/raco/zo-struct.scrbl @@ -274,12 +274,17 @@ binding, constructor, etc.} The @racket[lang-info] value specifies an optional module path that provides information about the module's implementation language. - The @racket[internal-context] value describes the lexical - context of the body of the module. This value is used by - @racket[module->namespace]. A @racket[#f] value means that the - context is unavailable or empty. A @racket[#t] value means that the - context is computed by re-importing all required modules. A - syntax-object value embeds an arbitrary lexical context. + The @racket[internal-context] value describes the lexical context of + the body of the module. This value is used by + @racket[module->namespace]. A @racket[#f] value means that the + context is unavailable or empty. A @racket[#t] value means that the + context is computed by re-importing all required modules. A + syntax-object value embeds lexical information; the syntax object + should contain a vector of two elements, where the first element of + the vector is a syntax object for the module's body, which includes + the outside-edge and inside-edge scopes, and the second element of + the vector is a syntax object that has just the module's inside-edge + scope. The @racket[binding-names] value provides additional information to @racket[module->namespace] to correlate symbol names for variables diff --git a/pkgs/racket-doc/scribblings/reference/stx-expand.scrbl b/pkgs/racket-doc/scribblings/reference/stx-expand.scrbl index 895f9f9bdc..b01ed3b522 100644 --- a/pkgs/racket-doc/scribblings/reference/stx-expand.scrbl +++ b/pkgs/racket-doc/scribblings/reference/stx-expand.scrbl @@ -105,6 +105,14 @@ to the syntax object: list of @tech{module path index}es (or symbols) representing the modules explicitly for-template imported into the module.} + @item{@indexed-racket['module-direct-for-meta-requires] --- a list of + lists: each list is an integer or @racket[#f] representing a + @tech{phase level} followed by a list of @tech{module path index}es + (or symbols) representing the modules explicitly imported into the + module at the corresponding phase. + + @history[#:added "6.4.0.1"]} + @item{@indexed-racket['module-variable-provides] --- a list of provided items, where each item is one of the following: @@ -138,5 +146,35 @@ to the syntax object: be exported indirectly through macro expansions. Definitions of macro-generated identifiers create uninterned symbols in this list.} + @item{@indexed-racket['module-body-inside-context] --- a syntax + object whose @tech{lexical information} corresponds to the inside of + the module, so it includes the expansion's @tech{outside-edge scope} + and its @tech{inside-edge scope}; that is, the syntax object + simulates an identifier that is present in the original module body + and inaccessible to manipulation by any macro, so that its lexical + information includes bindings for the module's imports and + definitions. + + @history[#:added "6.4.0.1"]} + + @item{@indexed-racket['module-body-outside-context] --- a syntax + object whose @tech{lexical information} corresponds to an identifier + that starts with no lexical context and is moved into the macro, so + that it includes only the expansions's @tech{inside-edge scope}. + + @history[#:added "6.4.0.1"]} + + @item{@indexed-racket['module-body-context-simple?] --- a boolean, + where @racket[#t] indicates that the bindings of the module's body + (as recorded in the @tech{lexical information} of the value of the + @racket['module-body-inside-context] property) can be directly + reconstructed from the values of @racket['module-direct-requires], + @racket['module-direct-for-syntax-requires], + @racket['module-direct-for-template-requires], and + @racket['module-direct-for-meta-requires]. + + @history[#:added "6.4.0.1"]} + + ] diff --git a/pkgs/racket-doc/scribblings/reference/syntax-model.scrbl b/pkgs/racket-doc/scribblings/reference/syntax-model.scrbl index 0b9fdab175..3028db2646 100644 --- a/pkgs/racket-doc/scribblings/reference/syntax-model.scrbl +++ b/pkgs/racket-doc/scribblings/reference/syntax-model.scrbl @@ -742,9 +742,7 @@ internal-definition context are equivalent to local binding via @racket[letrec-syntaxes+values]; macro expansion converts internal definitions to a @racket[letrec-syntaxes+values] form. -Expansion of an internal-definition context begins with the -introduction of a fresh @tech{scope} for the context. Thereafter, -expansion relies on @tech{partial expansion} of each @racket[_body] in +Expansion relies on @tech{partial expansion} of each @racket[_body] in an internal-definition sequence. Partial expansion of each @racket[_body] produces a form matching one of the following cases: @@ -782,8 +780,25 @@ are then converted to bindings in a @racket[letrec-syntaxes+values] form, and all expressions after the last definition become the body of the @racket[letrec-syntaxes+values] form. +Before partial expansion begins, expansion of an internal-definition +context begins with the introduction of a fresh @deftech{outside-edge +scope} on the content of the internal-definition context. This +outside-edge scope effectively identifies syntax objects that are +present in the original form. An @deftech{inside-edge scope} is also +created and added to the original content; furthermore, the +inside-edge scope is added to the result of any partial expansion. +This inside-edge scope ensures that all bindings introduced by the +internal-definition context have a particular scope in common. + @;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -@subsection[#:tag "mod-parse"]{Module Phases and Visits} +@subsection[#:tag "mod-parse"]{Module Expansion, Phases, and Visits} + +Expansion of a @racket[module] form proceeds in a similar way to +@seclink["intdef-body"]{expansion of an internal-definition context}: +an @tech{outside-edge scope} is created for the original module +content, and an @tech{inside-edge scope} is added to both the original +module and any form that appears during a partial expansion of the +module's top-level forms to uncover definitions and imports. A @racket[require] form not only introduces @tech{bindings} at expansion time, but also @deftech{visits} the referenced module when diff --git a/pkgs/racket-test-core/tests/racket/module.rktl b/pkgs/racket-test-core/tests/racket/module.rktl index 6333e70c86..579c1f67ed 100644 --- a/pkgs/racket-test-core/tests/racket/module.rktl +++ b/pkgs/racket-test-core/tests/racket/module.rktl @@ -1719,6 +1719,35 @@ case of module-leve bindings; it doesn't cover local bindings. (require 'exports-x**-as-x) (test 5 'five (x)) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Check 'module-body-context-simple? and 'module-body-...context properties + +(define (check-module-body-context-properties with-kar?) + (define m (expand `(module m racket/base + ,@(if with-kar? + `((require (rename-in racket/base [car kar]))) + null) + (define inside 7)))) + + (test (not with-kar?) syntax-property m 'module-body-context-simple?) + + (define i (syntax-property m 'module-body-inside-context)) + (define o (syntax-property m 'module-body-outside-context)) + + (test #t syntax? i) + (test #t syntax? o) + + (test car eval-syntax (datum->syntax i 'car)) + (test 'inside cadr (identifier-binding (datum->syntax i 'inside))) + (test #f identifier-binding (datum->syntax o 'inside)) + (test (if with-kar? 'car #f) + 'kar-binding + (let ([v (identifier-binding (datum->syntax i 'kar))]) + (and v (cadr v))))) + +(check-module-body-context-properties #f) +(check-module-body-context-properties #t) + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (report-errs) diff --git a/racket/src/racket/src/module.c b/racket/src/racket/src/module.c index 3c5822bf0c..214e3e115a 100644 --- a/racket/src/racket/src/module.c +++ b/racket/src/racket/src/module.c @@ -7433,8 +7433,14 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env, cons(fm, scheme_null)))); fm = scheme_datum_to_syntax(fm, form, ctx_form, 0, 2); + + /* for future expansion, shift away from self_modidx: */ + ps = scheme_make_shift(NULL, self_modidx, this_empty_self_modidx, NULL, NULL, NULL); + fm = scheme_stx_add_shift(fm, ps); if (hints) { + Scheme_Object *stx, *l; + fm = scheme_stx_property(fm, scheme_intern_symbol("module-direct-requires"), m->requires); @@ -7444,6 +7450,24 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env, fm = scheme_stx_property(fm, scheme_intern_symbol("module-direct-for-template-requires"), m->tt_requires); + + l = scheme_null; + if (!SCHEME_NULLP(m->dt_requires)) + l = scheme_make_pair(scheme_make_pair(scheme_false, m->dt_requires), + l); + if (m->other_requires) { + int i; + for (i = 0; i < m->other_requires->size; i++) { + if (m->other_requires->vals[i]) { + l = scheme_make_pair(scheme_make_pair(m->other_requires->keys[i], + m->other_requires->vals[i]), + l); + } + } + } + fm = scheme_stx_property(fm, + scheme_intern_symbol("module-direct-for-meta-requires"), + l); fm = scheme_stx_property(fm, scheme_intern_symbol("module-variable-provides"), @@ -7463,11 +7487,25 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env, fm = scheme_stx_property(fm, scheme_intern_symbol("module-self-path-index"), this_empty_self_modidx); - } - /* for future expansion, shift away from self_modidx: */ - ps = scheme_make_shift(NULL, self_modidx, this_empty_self_modidx, NULL, NULL, NULL); - fm = scheme_stx_add_shift(fm, ps); + fm = scheme_stx_property(fm, + scheme_intern_symbol("module-body-context-simple?"), + (SAME_OBJ(scheme_true, m->rn_stx) + ? scheme_true + : scheme_false)); + + stx = scheme_datum_to_syntax(scheme_intern_symbol("inside"), scheme_false, scheme_false, 0, 0); + stx = scheme_stx_add_module_context(stx, rn_set); + fm = scheme_stx_property(fm, + scheme_intern_symbol("module-body-inside-context"), + scheme_stx_add_shift(stx, ps)); + + stx = scheme_datum_to_syntax(scheme_intern_symbol("outside"), scheme_false, scheme_false, 0, 0); + stx = scheme_stx_introduce_to_module_context(stx, rn_set); + fm = scheme_stx_property(fm, + scheme_intern_symbol("module-body-outside-context"), + scheme_stx_add_shift(stx, ps)); + } /* make self_modidx like the empty modidx */ if (SAME_OBJ(this_empty_self_modidx, empty_self_modidx)) @@ -8383,7 +8421,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env result = scheme_null; - /* kernel re-export info (always #f): */ + /* kernel re-export info (now always #f): */ result = scheme_make_pair(scheme_false, result); /* Indirect provides */ @@ -8467,6 +8505,12 @@ static Scheme_Object *do_module_begin(Scheme_Object *orig_form, Scheme_Comp_Env add_binding_names_from_environment(env->genv->module, bnenv); } } + } else { + /* For a property on the expanded module: */ + if (*all_simple_bindings && env->genv->module->rn_stx) { + /* We will be able to reconstruct binding for `module->namespace`: */ + env->genv->module->rn_stx = scheme_true; + } } if (rec[drec].comp || has_submodules) {