suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix syntax-local-submodules' in expand' mode

Browse Source
This commit is contained in:
Matthew Flatt 2013-02-12 19:30:03 -07:00
parent 6ae2c71ed5
commit 4a0adb6a74
4 changed files with 62 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/tests/racket/submodule.rktl
View File

@ -799,4 +799,24 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(let ([e '(module x racket/base
(require (for-syntax racket/base))
(module m racket/base)
(define-syntax (m stx)
#`(quote #,(syntax-local-submodules)))
(define x (m))
x
(provide x))])
(parameterize ([current-namespace (make-base-namespace)])
(eval e)
(test '(m) dynamic-require ''x 'x))
(parameterize ([current-namespace (make-base-namespace)])
(eval (expand e))
(test '(m) dynamic-require ''x 'x)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

12
src/racket/src/env.c
View File

@ -2525,11 +2525,15 @@ static Scheme_Object *local_submodules(int argc, Scheme_Object *argv[])
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);
n = SCHEME_CAR(l);
if (!SCHEME_SYMBOLP(n)) {
n = scheme_resolved_module_path_value(((Scheme_Module *)n)->modname);
while (SCHEME_PAIRP(SCHEME_CDR(n))) {
n = SCHEME_CDR(n);
}
n = SCHEME_CAR(n);
}
r = scheme_make_pair(SCHEME_CAR(n), r);
r = scheme_make_pair(n, r);
l = SCHEME_CDR(l);
}
}

46
src/racket/src/module.c
View File

@ -6219,8 +6219,10 @@ static void execute_submodules(Scheme_Module *m, int pre, Scheme_Env *genv,
}
while (!SCHEME_NULLP(p)) {
do_module_execute_recur(SCHEME_CAR(p), genv, set_cache, set_in_pre, prefix,
(Scheme_Object *)m);
if (!SCHEME_SYMBOLP(SCHEME_CAR(p))) {
do_module_execute_recur(SCHEME_CAR(p), genv, set_cache, set_in_pre, prefix,
(Scheme_Object *)m);
}
p = SCHEME_CDR(p);
}
}
@ -6508,10 +6510,12 @@ static Scheme_Object *do_module_clone(Scheme_Object *data, int jit)
if (l1 && !SCHEME_NULLP(l1)) {
l2 = scheme_null;
while (!SCHEME_NULLP(l1)) {
sm = do_module_clone(SCHEME_CAR(l1), jit);
if (!SAME_OBJ(sm, SCHEME_CAR(l1)))
submod_changed = 1;
l2 = scheme_make_pair(sm, l2);
if (!SCHEME_SYMBOLP(SCHEME_CAR(l1))) {
sm = do_module_clone(SCHEME_CAR(l1), jit);
if (!SAME_OBJ(sm, SCHEME_CAR(l1)))
submod_changed = 1;
l2 = scheme_make_pair(sm, l2);
}
l1 = SCHEME_CDR(l1);
}
if (submod_changed) {
@ -9256,8 +9260,20 @@ static Scheme_Object *expand_submodules(Scheme_Compile_Expand_Info *rec, int dre
env->genv->module->pre_submodules = l;
}
} else if (!SCHEME_NULLP(mods)) {
/* setting pre_submodules to '() indicates that there were submodules during expansion */
env->genv->module->pre_submodules = scheme_null;
if (post) {
/* setting pre_submodules to '() indicates that there were submodules during expansion */
env->genv->module->pre_submodules = scheme_null;
} else {
l = env->genv->module->pre_submodules;
if (!l) l = scheme_null;
/* extract just the name: */
mod = SCHEME_CAR(mods);
mod = SCHEME_STX_CDR(mod);
mod = SCHEME_STX_CAR(mod);
mod = SCHEME_STX_VAL(mod);
l = scheme_make_pair(mod, l);
env->genv->module->pre_submodules = l;
}
}
return mods;
@ -10950,13 +10966,15 @@ static int check_is_submodule(Scheme_Object *modname, Scheme_Object *_genv)
l = 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);
if (!SCHEME_SYMBOLP(SCHEME_CAR(l))) {
n = scheme_resolved_module_path_value(((Scheme_Module *)SCHEME_CAR(l))->modname);
while (SCHEME_PAIRP(SCHEME_CDR(n))) {
n = SCHEME_CDR(n);
}
n = SCHEME_CAR(n);
if (SAME_OBJ(n, modname))
return 1;
}
n = SCHEME_CAR(n);
if (SAME_OBJ(n, modname))
return 1;
l = SCHEME_CDR(l);
}
}

3
src/racket/src/schpriv.h
View File

@ -3294,7 +3294,8 @@ typedef struct Scheme_Module
Scheme_Object *rn_stx; /* NULL, #t, a stx for a rename, a vector of stxes, or a pair to delay shifts */
Scheme_Object *submodule_path; /* path to this module relative to enclosing top-level module */
Scheme_Object *pre_submodules, *post_submodules; /* list of modules (when compiled or loaded as a group) */
Scheme_Object *pre_submodules; /* list of modules (when compiled or loaded as a group) or symbols (during expand) */
Scheme_Object *post_submodules; /* list of modules (when compiled or loaded as a group) */
Scheme_Object *supermodule; /* supermodule for which this is in {pre,post}_submodules */
Scheme_Object *submodule_ancestry; /* se by compile/expand, temporary */
} Scheme_Module;