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

fix interaction of shadower, rename trasnformer, and free-id=?

Browse Source
This commit is contained in:
Matthew Flatt 2013-06-05 07:13:14 -06:00
parent 81b21e4222
commit 8a350a7dfd
4 changed files with 26 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/tests/racket/macro.rktl
View File

@ -230,6 +230,14 @@
(foozzz foozz)
foozz)))
(test #t 'free-identifier=?-of-rename-via-shadower
(let ([y 5])
(let-syntax ([m (lambda (stx)
#`(quote-syntax #,(syntax-local-get-shadower #'x)))])
(let-syntax ([x (make-rename-transformer #'y)])
(free-identifier=? (m) #'y)))))
(test #t set!-transformer? (make-set!-transformer void))
(test #t rename-transformer? (make-rename-transformer #'void))

14
src/racket/src/compenv.c
View File

@ -2439,10 +2439,11 @@ Scheme_Object *scheme_namespace_lookup_value(Scheme_Object *sym, Scheme_Env *gen
return v;
}
Scheme_Object *scheme_find_local_shadower(Scheme_Object *sym, Scheme_Object *sym_marks, Scheme_Comp_Env *env)
Scheme_Object *scheme_find_local_shadower(Scheme_Object *sym, Scheme_Object *sym_marks, Scheme_Comp_Env *env,
Scheme_Object **_free_id)
{
Scheme_Comp_Env *frame;
Scheme_Object *esym, *uid = NULL, *env_marks, *prop;
Scheme_Object *esym, *uid = NULL, *env_marks, *prop, *val;
/* Walk backward through the frames, looking for a renaming binding
with the same marks as the given identifier, sym. Skip over
@ -2482,12 +2483,19 @@ Scheme_Object *scheme_find_local_shadower(Scheme_Object *sym, Scheme_Object *sym
prop = scheme_stx_property(esym, unshadowable_symbol, NULL);
if (SCHEME_FALSEP(prop)) {
env_marks = scheme_stx_extract_marks(esym);
if (scheme_equal(env_marks, sym_marks)) { /* This used to have 1 || --- why? */
if (scheme_equal(env_marks, sym_marks)) {
sym = esym;
if (COMPILE_DATA(frame)->const_uids)
uid = COMPILE_DATA(frame)->const_uids[i];
else
uid = frame->uid;
val = COMPILE_DATA(frame)->const_vals[i];
if (val && SAME_TYPE(SCHEME_TYPE(val), scheme_macro_type)) {
if (scheme_is_binding_rename_transformer(SCHEME_PTR_VAL(val))) {
val = scheme_rename_transformer_id(SCHEME_PTR_VAL(val));
*_free_id = val;
}
}
break;
}
}

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

@ -2327,7 +2327,7 @@ static Scheme_Object *
local_get_shadower(int argc, Scheme_Object *argv[])
{
Scheme_Comp_Env *env;
Scheme_Object *sym, *sym_marks = NULL, *orig_sym, *uid = NULL;
Scheme_Object *sym, *sym_marks = NULL, *orig_sym, *uid = NULL, *free_id = NULL;
env = scheme_current_thread->current_local_env;
if (!env)
@ -2341,7 +2341,7 @@ local_get_shadower(int argc, Scheme_Object *argv[])
sym_marks = scheme_stx_extract_marks(sym);
uid = scheme_find_local_shadower(sym, sym_marks, env);
uid = scheme_find_local_shadower(sym, sym_marks, env, &free_id);
if (!uid) {
uid = scheme_tl_id_sym(env->genv, sym, NULL, 0,
@ -2366,12 +2366,15 @@ local_get_shadower(int argc, Scheme_Object *argv[])
result = scheme_datum_to_syntax(SCHEME_STX_VAL(sym), orig_sym, sym, 0, 0);
((Scheme_Stx *)result)->props = ((Scheme_Stx *)orig_sym)->props;
rn = scheme_make_rename(uid, 1);
scheme_set_rename(rn, 0, result);
result = scheme_add_rename(result, rn);
if (free_id)
scheme_install_free_id_rename(result, free_id, NULL, scheme_make_integer(0));
if (!scheme_stx_is_clean(orig_sym))
result = scheme_stx_taint(result);

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

@ -2677,7 +2677,7 @@ Scheme_Comp_Env *scheme_new_expand_env(Scheme_Env *genv, Scheme_Object *insp, in
Scheme_Object *scheme_namespace_lookup_value(Scheme_Object *sym, Scheme_Env *genv,
Scheme_Object **_id, int *_use_map);
Scheme_Object *scheme_find_local_shadower(Scheme_Object *sym, Scheme_Object *sym_marks,
Scheme_Comp_Env *env);
Scheme_Comp_Env *env, Scheme_Object **_free_id);
Scheme_Object *scheme_do_local_lift_expr(const char *who, int stx_pos,
int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_local_lift_context(Scheme_Comp_Env *env);