add `syntax-local-submodules'

This commit is contained in:
Matthew Flatt 2012-05-14 21:14:49 -06:00
parent cee18bd887
commit 0653d1c966
6 changed files with 72 additions and 12 deletions

View File

@ -615,6 +615,15 @@ exports of the module.
@transform-time[]}
@defproc[(syntax-local-submodules) (listof symbol?)]{
Returns a list of submodule names that are declared via
@racket[module] (as opposed to @racket[module*]) in the current
expansion context.
@transform-time[]}
@defproc[(syntax-local-get-shadower [id-stx identifier?]) identifier?]{
Returns @racket[id-stx] if no binding in the current expansion context

View File

@ -515,6 +515,26 @@
(test 10 dynamic-require '(submod 'subm-all-defined-1 main) 'x)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check `syntax-local-submodules':
(test '() 'local-submodules
(let ()
(define-syntax (m stx) #`(quote #,(syntax-local-submodules)))
(m)))
(module check-submodule-list racket/base
(require (for-syntax racket/base))
(provide x)
(define-syntax (m stx) #`(quote #,(syntax-local-submodules)))
(module m1 racket/base)
(module m2 racket/base)
(module* m3 racket/base)
(define x (m)))
(test '(m1 m2) dynamic-require ''check-submodule-list 'x)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Directory for testing

View File

@ -1,5 +1,6 @@
Version 5.3.0.8
Added variable-reference->module-path-index
Added syntax-local-submodules
Version 5.3.0.7
compiler/zo-struct: added cancel-id field to phase-shift

View File

@ -16,12 +16,12 @@
108,101,116,114,101,99,45,118,97,108,117,101,115,66,108,97,109,98,100,97,1,
20,112,97,114,97,109,101,116,101,114,105,122,97,116,105,111,110,45,107,101,121,
61,118,73,100,101,102,105,110,101,45,118,97,108,117,101,115,97,36,11,8,240,
248,81,0,0,95,159,2,17,36,36,159,2,16,36,36,159,2,16,36,36,16,
7,82,0,0,95,159,2,17,36,36,159,2,16,36,36,159,2,16,36,36,16,
20,2,10,2,2,2,3,2,2,2,5,2,2,2,6,2,2,2,7,2,2,
2,8,2,2,2,9,2,2,2,4,2,2,2,11,2,2,2,12,2,2,97,
37,11,8,240,248,81,0,0,93,159,2,16,36,37,16,2,2,13,161,2,2,
37,2,13,2,2,2,13,96,38,11,8,240,248,81,0,0,16,0,96,11,11,
8,240,248,81,0,0,16,0,18,98,64,104,101,114,101,13,16,6,36,2,14,
37,11,8,240,7,82,0,0,93,159,2,16,36,37,16,2,2,13,161,2,2,
37,2,13,2,2,2,13,96,38,11,8,240,7,82,0,0,16,0,96,11,11,
8,240,7,82,0,0,16,0,18,98,64,104,101,114,101,13,16,6,36,2,14,
2,2,11,11,11,8,32,8,31,8,30,8,29,27,248,22,157,4,195,249,22,
150,4,80,158,39,36,251,22,83,2,18,248,22,98,199,12,249,22,73,2,19,
248,22,100,201,27,248,22,157,4,195,249,22,150,4,80,158,39,36,251,22,83,
@ -30,14 +30,14 @@
75,194,248,22,74,193,249,22,150,4,80,158,39,36,251,22,83,2,18,248,22,
74,199,249,22,73,2,8,248,22,75,201,11,18,100,10,13,16,6,36,2,14,
2,2,11,11,11,8,32,8,31,8,30,8,29,16,4,11,11,2,20,3,1,
8,101,110,118,49,53,53,52,52,16,4,11,11,2,21,3,1,8,101,110,118,
49,53,53,52,53,27,248,22,75,248,22,157,4,196,28,248,22,81,193,20,14,
8,101,110,118,49,53,53,54,49,16,4,11,11,2,21,3,1,8,101,110,118,
49,53,53,54,50,27,248,22,75,248,22,157,4,196,28,248,22,81,193,20,14,
159,37,36,37,28,248,22,81,248,22,75,194,248,22,74,193,249,22,150,4,80,
158,39,36,250,22,83,2,22,248,22,83,249,22,83,248,22,83,2,23,248,22,
74,201,251,22,83,2,18,2,23,2,23,249,22,73,2,5,248,22,75,204,18,
100,11,13,16,6,36,2,14,2,2,11,11,11,8,32,8,31,8,30,8,29,
16,4,11,11,2,20,3,1,8,101,110,118,49,53,53,52,55,16,4,11,11,
2,21,3,1,8,101,110,118,49,53,53,52,56,248,22,157,4,193,27,248,22,
16,4,11,11,2,20,3,1,8,101,110,118,49,53,53,54,52,16,4,11,11,
2,21,3,1,8,101,110,118,49,53,53,54,53,248,22,157,4,193,27,248,22,
157,4,194,249,22,73,248,22,83,248,22,74,196,248,22,75,195,27,248,22,75,
248,22,157,4,23,197,1,249,22,150,4,80,158,39,36,28,248,22,58,248,22,
151,4,248,22,74,23,198,2,27,249,22,2,32,0,88,163,8,36,37,43,11,
@ -67,8 +67,8 @@
83,2,18,28,249,22,144,9,248,22,151,4,248,22,74,200,64,101,108,115,101,
10,248,22,74,197,250,22,84,2,22,9,248,22,75,200,249,22,73,2,3,248,
22,75,202,99,13,16,6,36,2,14,2,2,11,11,11,8,32,8,31,8,30,
8,29,16,4,11,11,2,20,3,1,8,101,110,118,49,53,53,55,48,16,4,
11,11,2,21,3,1,8,101,110,118,49,53,53,55,49,18,158,94,10,64,118,
8,29,16,4,11,11,2,20,3,1,8,101,110,118,49,53,53,56,55,16,4,
11,11,2,21,3,1,8,101,110,118,49,53,53,56,56,18,158,94,10,64,118,
111,105,100,8,48,27,248,22,75,248,22,157,4,196,249,22,150,4,80,158,39,
36,28,248,22,58,248,22,151,4,248,22,74,197,250,22,83,2,28,248,22,83,
248,22,74,199,248,22,98,198,27,248,22,151,4,248,22,74,197,250,22,83,2,
@ -992,7 +992,7 @@
114,107,11,29,94,2,2,68,35,37,112,97,114,97,109,122,11,29,94,2,2,
74,35,37,112,108,97,99,101,45,115,116,114,117,99,116,11,29,94,2,2,66,
35,37,98,111,111,116,11,29,94,2,2,68,35,37,101,120,112,111,98,115,11,
29,94,2,2,68,35,37,107,101,114,110,101,108,11,97,36,11,8,240,245,83,
29,94,2,2,68,35,37,107,101,114,110,101,108,11,97,36,11,8,240,4,84,
0,0,100,159,2,3,36,36,159,2,4,36,36,159,2,5,36,36,159,2,6,
36,36,159,2,7,36,36,159,2,8,36,36,159,2,9,36,36,159,2,9,36,
36,16,0,159,36,20,113,159,36,16,1,11,16,0,20,26,144,9,2,1,2,

View File

@ -100,6 +100,7 @@ static Scheme_Object *local_module_introduce(int argc, Scheme_Object *argv[]);
static Scheme_Object *local_get_shadower(int argc, Scheme_Object *argv[]);
static Scheme_Object *local_module_exports(int argc, Scheme_Object *argv[]);
static Scheme_Object *local_module_definitions(int argc, Scheme_Object *argv[]);
static Scheme_Object *local_submodules(int argc, Scheme_Object *argv[]);
static Scheme_Object *local_module_imports(int argc, Scheme_Object *argv[]);
static Scheme_Object *local_module_expanding_provides(int argc, Scheme_Object *argv[]);
static Scheme_Object *local_lift_expr(int argc, Scheme_Object *argv[]);
@ -684,6 +685,7 @@ static void make_kernel_env(void)
GLOBAL_PRIM_W_ARITY("syntax-local-module-exports", local_module_exports, 1, 1, env);
GLOBAL_PRIM_W_ARITY("syntax-local-module-defined-identifiers", local_module_definitions, 0, 0, env);
GLOBAL_PRIM_W_ARITY("syntax-local-submodules", local_submodules, 0, 0, env);
GLOBAL_PRIM_W_ARITY("syntax-local-module-required-identifiers", local_module_imports, 2, 2, env);
GLOBAL_PRIM_W_ARITY("syntax-local-transforming-module-provides?", local_module_expanding_provides, 0, 0, env);
@ -2435,6 +2437,34 @@ local_module_exports(int argc, Scheme_Object *argv[])
return scheme_module_exported_list(argv[0], env->genv);
}
static Scheme_Object *local_submodules(int argc, Scheme_Object *argv[])
{
Scheme_Comp_Env *env;
Scheme_Object *l, *r = scheme_null, *n;
env = scheme_current_thread->current_local_env;
if (!env)
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"syntax-local-submodules: not currently transforming");
if (env->genv->module) {
l = env->genv->module->pre_submodules;
if (l) {
while (!SCHEME_NULLP(l)) {
n = scheme_resolved_module_path_value(((Scheme_Module *)SCHEME_CAR(l))->modname);
while (SCHEME_PAIRP(SCHEME_CDR(n))) {
n = SCHEME_CDR(n);
}
r = scheme_make_pair(SCHEME_CAR(n), r);
l = SCHEME_CDR(l);
}
}
}
return r;
}
static Scheme_Object *
local_module_definitions(int argc, Scheme_Object *argv[])
{

View File

@ -14,7 +14,7 @@
#define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 1048
#define EXPECTED_PRIM_COUNT 1049
#define EXPECTED_UNSAFE_COUNT 79
#define EXPECTED_FLFXNUM_COUNT 69
#define EXPECTED_FUTURES_COUNT 13