fix problems with phase-1 syntax definitions
Closes PR 12234
This commit is contained in:
parent
a857e9e041
commit
99fe14b080
|
@ -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)
|
||||||
|
|
|
@ -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++;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
|
@ -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))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user