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

fix problems with phase-1 syntax definitions

Browse Source 
Closes PR 12234
This commit is contained in:
Matthew Flatt 2011-09-29 16:15:51 -06:00
parent a857e9e041
commit 99fe14b080
3 changed files with 35 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -598,6 +598,26 @@
(require
(rename-in (dynamic-in service))))))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check phase-1 syntax used via for-template
;; and other indirections
(module there-and-back-x racket/base
(require (for-syntax racket/base))
(begin-for-syntax
(provide s s?)
(struct s (x y))))
(module there-and-back-y racket/base
(require (for-template 'there-and-back-x))
(s 1 2)
(provide s s?))
(module there-and-back-z racket/base
(require 'there-and-back-y)
(provide f)
(define (f) (s 1 2)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

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

@ -3601,12 +3601,15 @@ Scheme_Env *scheme_module_access(Scheme_Object *name, Scheme_Env *env, intptr_t
if (!menv) {
Scheme_Object *chain;
int ph;
chain = env->modchain;
if (rev_mod_phase && chain) {
ph = rev_mod_phase;
while (ph && chain) {
chain = (SCHEME_VEC_ELS(chain))[2];
if (SCHEME_FALSEP(chain))
return NULL;
ph--;
}
if (!chain) {
@ -3616,8 +3619,10 @@ Scheme_Env *scheme_module_access(Scheme_Object *name, Scheme_Env *env, intptr_t
menv = (Scheme_Env *)scheme_hash_get(MODCHAIN_TABLE(chain), name);
if (rev_mod_phase && menv)
while ((ph < rev_mod_phase) && menv) {
menv = menv->exp_env;
ph++;
}
}
return menv;
@ -3951,6 +3956,7 @@ Scheme_Object *scheme_module_syntax(Scheme_Object *modname, Scheme_Env *env,
int i;
for (i = 0; i < mod_phase; i++) {
scheme_prepare_template_env(env);
env = env->template_env;
if (!env) return NULL;
}
@ -3961,6 +3967,7 @@ Scheme_Object *scheme_module_syntax(Scheme_Object *modname, Scheme_Env *env,
return NULL;
for (i = 0; i < mod_phase; i++) {
scheme_prepare_exp_env(menv);
menv = menv->exp_env;
if (!menv) return NULL;
}
@ -8451,6 +8458,7 @@ void compute_provide_arrays(Scheme_Hash_Table *all_provided, Scheme_Hash_Table *
noms = adjust_for_rename(exs[count], SCHEME_VEC_ELS(v)[4], SCHEME_VEC_ELS(v)[0]);
exsnoms[count] = noms;
exps[count] = protected;
exets[count] = SCHEME_INT_VAL(SCHEME_VEC_ELS(v)[8]);
count++;
}
}

5
src/racket/src/syntax.c
View File

@ -3387,6 +3387,7 @@ static Scheme_Object *search_shared_pes(Scheme_Object *shared_pes,
phase = 0;
EXPLAIN(fprintf(stderr, "%d srcname %s\n", depth, SCHEME_SYM_VAL(pt->provide_src_names[i])));
EXPLAIN(fprintf(stderr, "%d mod phase %d\n", depth, phase));
get_names[0] = pt->provide_src_names[i];
get_names[1] = idx;
get_names[2] = glob_id;
@ -3765,6 +3766,10 @@ static Scheme_Object *resolve_env(Scheme_Object *a, Scheme_Object *orig_phase,
} else {
EXPLAIN(fprintf(stderr, "%d Result: %s\n", depth, scheme_write_to_string(result, NULL)));
}
if (get_names) {
EXPLAIN(fprintf(stderr, "%d phase %s\n", depth, scheme_write_to_string(get_names[3], NULL)));
}
return result;
} else if ((SCHEME_RENAMESP(WRAP_POS_FIRST(wraps))