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

fix certificate problem related to macro-generating macros and transparent result forms

Browse Source 
svn: r5798
This commit is contained in:
Matthew Flatt 2007-03-20 02:24:11 +00:00
parent a5b71fccbf
commit 8928f80384
3 changed files with 25 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
src/mzscheme/src/fun.c
View File

@ -2296,7 +2296,8 @@ _scheme_tail_apply_to_list (Scheme_Object *rator, Scheme_Object *rands)
static Scheme_Object *
cert_with_specials(Scheme_Object *code, Scheme_Object *mark, Scheme_Env *menv,
Scheme_Object *orig_code, Scheme_Comp_Env *cenv, int phase,
Scheme_Object *orig_code, Scheme_Object *closest_code,
Scheme_Comp_Env *cenv, int phase,
int deflt, int cadr_deflt)
{
Scheme_Object *prop;
@ -2374,10 +2375,16 @@ cert_with_specials(Scheme_Object *code, Scheme_Object *mark, Scheme_Env *menv,
if (SCHEME_STX_PAIRP(code)) {
Scheme_Object *a, *d, *v;
if (SCHEME_STXP(code))
closest_code = code;
a = SCHEME_STX_CAR(code);
a = cert_with_specials(a, mark, menv, orig_code, cenv, phase, cadr_deflt, 0);
a = scheme_stx_propagate_inactive_certs(a, closest_code);
a = cert_with_specials(a, mark, menv, orig_code, closest_code, cenv, phase, cadr_deflt, 0);
d = SCHEME_STX_CDR(code);
d = cert_with_specials(d, mark, menv, orig_code, cenv, phase, 1, next_cadr_deflt);
if (SCHEME_STXP(d))
d = scheme_stx_propagate_inactive_certs(d, closest_code);
d = cert_with_specials(d, mark, menv, orig_code, closest_code, cenv, phase, 1, next_cadr_deflt);
v = scheme_make_pair(a, d);
@ -2428,7 +2435,7 @@ scheme_apply_macro(Scheme_Object *name, Scheme_Env *menv,
code = scheme_datum_to_syntax(code, orig_code, scheme_sys_wraps(env), 0, 0);
}
code = cert_with_specials(code, mark, menv, orig_code, env, env->genv->phase, 0, 0);
code = cert_with_specials(code, mark, menv, orig_code, orig_code, env, env->genv->phase, 0, 0);
code = scheme_stx_track(code, orig_code, name);
@ -2463,7 +2470,7 @@ scheme_apply_macro(Scheme_Object *name, Scheme_Env *menv,
code = scheme_add_remove_mark(code, mark);
code = cert_with_specials(code, mark, menv, orig_code, env, env->genv->phase, 0, 0);
code = cert_with_specials(code, mark, menv, orig_code, orig_code, env, env->genv->phase, 0, 0);
code = scheme_stx_track(code, orig_code, name);

1
src/mzscheme/src/schpriv.h
View File

@ -715,6 +715,7 @@ Scheme_Object *scheme_stx_activate_certs(Scheme_Object *stx);
Scheme_Object *scheme_stx_extract_certs(Scheme_Object *o, Scheme_Object *base_certs);
Scheme_Object *scheme_stx_add_inactive_certs(Scheme_Object *o, Scheme_Object *certs);
Scheme_Object *scheme_stx_propagate_inactive_certs(Scheme_Object *o, Scheme_Object *orig);
int scheme_stx_has_more_certs(Scheme_Object *id, Scheme_Object *certs,
Scheme_Object *than_id, Scheme_Object *than_certs);

12
src/mzscheme/src/stxobj.c
View File

@ -2050,6 +2050,18 @@ Scheme_Object *scheme_stx_add_inactive_certs(Scheme_Object *o, Scheme_Object *ce
return add_certs(o, (Scheme_Cert *)certs, NULL, 0);
}
Scheme_Object *scheme_stx_propagate_inactive_certs(Scheme_Object *o, Scheme_Object *orig)
{
Scheme_Cert *certs;
certs = INACTIVE_CERTS((Scheme_Stx *)orig);
if (certs)
return scheme_stx_add_inactive_certs(o, (Scheme_Object *)certs);
else
return o;
}
Scheme_Object *scheme_stx_extract_certs(Scheme_Object *o, Scheme_Object *base_certs)
{
return (Scheme_Object *)append_certs((Scheme_Cert *)base_certs,