fix problems with phase-1 syntax definitions

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

View File

@ -598,6 +598,26 @@
(require (require
(rename-in (dynamic-in service)))))))) (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) (report-errs)

View File

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

View File

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