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

fix two macro-expansion bugs: local-expand with internal syntax definitions, and simplifying rename records that involve internal-definition ribs

Browse Source 
svn: r5053
This commit is contained in:
Matthew Flatt 2006-12-07 02:08:37 +00:00
parent 6335ee3c03
commit 4bfa93feac
4 changed files with 1518 additions and 1493 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2898
src/mzscheme/src/cstartup.inc
View File

File diff suppressed because it is too large Load Diff

6
src/mzscheme/src/eval.c
View File

@ -5128,8 +5128,12 @@ scheme_compile_expand_block(Scheme_Object *forms, Scheme_Comp_Env *env,
if (SCHEME_STX_PAIRP(result)) {
if (!start)
start = scheme_null;
/* I think the following was intended as an optimization for `expand',
since the syntax definition will be dropped. But it breaks
`local-expand':
if (stx_start && !(rec[drec].comp || (rec[drec].depth == -1)))
stx_start = scheme_null;
stx_start = scheme_null; */
if (stx_start) {
result = scheme_make_immutable_pair(letrec_syntaxes_symbol,
scheme_make_immutable_pair(stx_start,

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

@ -3667,7 +3667,7 @@ static void simplify_lex_renames(Scheme_Object *wraps, Scheme_Hash_Table *lex_ca
WRAP_POS prev;
WRAP_POS w2;
Scheme_Object *stack = scheme_null, *key, *old_key;
Scheme_Object *v, *v2, *v2l, *stx, *name;
Scheme_Object *v, *v2, *v2l, *stx, *name, *svl;
long size, vsize, psize, i, j, pos;
/* Although it makes no sense to simplify the rename table itself,
@ -3795,9 +3795,11 @@ static void simplify_lex_renames(Scheme_Object *wraps, Scheme_Hash_Table *lex_ca
/* Either this name is in prev, in which case the answer
must match this rename's target, or this rename's
answer applies. */
Scheme_Object *ok = NULL;
Scheme_Object *ok = NULL, *ok_replace = NULL;
int ok_replace_index = 0;
if (!WRAP_POS_END_P(prev)) {
if (!WRAP_POS_END_P(prev)
|| SCHEME_PAIRP(v2l)) {
WRAP_POS w3;
Scheme_Object *vp;
Scheme_Object *other_env;
@ -3815,8 +3817,15 @@ static void simplify_lex_renames(Scheme_Object *wraps, Scheme_Hash_Table *lex_ca
}
if (other_env) {
/* First, check simplications in v2l.
If not in v2l, try prev. */
if (!ok) {
WRAP_POS_COPY(w3, prev);
for (; !WRAP_POS_END_P(w3); WRAP_POS_INC(w3)) {
svl = v2l;
for (; SCHEME_PAIRP(svl) || !WRAP_POS_END_P(w3); ) {
if (SCHEME_PAIRP(svl))
vp = SCHEME_CAR(svl);
else
vp = WRAP_POS_FIRST(w3);
if (SCHEME_VECTORP(vp)) {
psize = SCHEME_RENAME_LEN(vp);
@ -3830,17 +3839,29 @@ static void simplify_lex_renames(Scheme_Object *wraps, Scheme_Hash_Table *lex_ca
SCHEME_VEC_ELS(vp)[2+psize+j],
which is the value from prev */
}
if (ok && SCHEME_PAIRP(svl)) {
/* Need to overwrite old map, instead
of adding a new one. */
ok_replace = vp;
ok_replace_index = 2 + psize + j;
}
break;
}
}
if (j < psize)
break;
}
if (SCHEME_PAIRP(svl))
svl = SCHEME_CDR(svl);
else {
WRAP_POS_INC(w3);
}
if (WRAP_POS_END_P(w3) && SCHEME_FALSEP(other_env))
}
if (WRAP_POS_END_P(w3) && SCHEME_NULLP(svl) && SCHEME_FALSEP(other_env))
ok = SCHEME_VEC_ELS(v)[0];
} else
ok = NULL;
}
} else {
WRAP_POS_INIT(w2, ((Scheme_Stx *)stx)->wraps);
if (same_marks(&w2, &w, scheme_false, (Scheme_Object *)init_rib))
@ -3850,10 +3871,14 @@ static void simplify_lex_renames(Scheme_Object *wraps, Scheme_Hash_Table *lex_ca
}
if (ok) {
if (ok_replace) {
SCHEME_VEC_ELS(ok_replace)[ok_replace_index] = ok;
} else {
SCHEME_VEC_ELS(v2)[2+size+pos] = ok;
pos++;
}
}
}
ii++;
}
@ -3875,8 +3900,6 @@ static void simplify_lex_renames(Scheme_Object *wraps, Scheme_Hash_Table *lex_ca
SCHEME_VEC_ELS(v2)[1] = scheme_false;
v2l = CONS(v2, v2l);
WRAP_POS_COPY(prev, w);
}
WRAP_POS_DEC(w);