diff --git a/src/mzscheme/src/env.c b/src/mzscheme/src/env.c index 0e52f7223f..7c64c50239 100644 --- a/src/mzscheme/src/env.c +++ b/src/mzscheme/src/env.c @@ -2123,7 +2123,8 @@ Scheme_Object *scheme_add_env_renames(Scheme_Object *stx, Scheme_Comp_Env *env, } while (env != upto) { - if (!(env->flags & (SCHEME_NO_RENAME | SCHEME_CAPTURE_WITHOUT_RENAME | SCHEME_CAPTURE_LIFTED))) { + if (!(env->flags & (SCHEME_NO_RENAME | SCHEME_CAPTURE_WITHOUT_RENAME + | SCHEME_CAPTURE_LIFTED | SCHEME_INTDEF_SHADOW))) { int i, count; /* How many slots filled in the frame so far? This can change @@ -2311,6 +2312,26 @@ Scheme_Object *scheme_add_env_renames(Scheme_Object *stx, Scheme_Comp_Env *env, stx = scheme_add_rename(stx, l); } } + } else if (env->flags & SCHEME_INTDEF_SHADOW) { + /* Just extract existing uids from identifiers, and don't need to + add renames to syntax objects. */ + if (!env->uids) { + Scheme_Object **uids, *uid; + int i; + + uids = MALLOC_N(Scheme_Object *, env->num_bindings); + env->uids = uids; + + for (i = env->num_bindings; i--; ) { + uid = scheme_stx_moduleless_env(env->values[i]); + if (SCHEME_FALSEP(uid)) + scheme_signal_error("intdef shadow binding is #f for %d/%s", + SCHEME_TYPE(env->values[i]), + scheme_write_to_string(SCHEME_STX_VAL(env->values[i]), + NULL)); + env->uids[i] = uid; + } + } } env = env->next; @@ -2446,7 +2467,7 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags, if (frame->values[i]) { if (frame->uids) uid = frame->uids[i]; - if (SAME_OBJ(SCHEME_STX_VAL(find_id), SCHEME_STX_VAL(frame->values[i])) + if (SAME_OBJ(SCHEME_STX_VAL(find_id), SCHEME_STX_VAL(frame->values[i])) && (scheme_stx_env_bound_eq(find_id, frame->values[i], uid, scheme_make_integer(phase)) || ((frame->flags & SCHEME_CAPTURE_WITHOUT_RENAME) && scheme_stx_module_eq2(find_id, frame->values[i], scheme_make_integer(phase), find_id_sym)) diff --git a/src/mzscheme/src/error.c b/src/mzscheme/src/error.c index 0fb36e3f88..bb4b052258 100644 --- a/src/mzscheme/src/error.c +++ b/src/mzscheme/src/error.c @@ -778,7 +778,7 @@ scheme_signal_error (const char *msg, ...) if (scheme_current_thread->current_local_env) { char *s2 = " [during expansion]"; strcpy(buffer + len, s2); - len = strlen(s2); + len += strlen(s2); } buffer[len] = 0; diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c index 1aff3b6e8a..ad1973066c 100644 --- a/src/mzscheme/src/eval.c +++ b/src/mzscheme/src/eval.c @@ -4563,6 +4563,7 @@ void scheme_init_compile_recs(Scheme_Compile_Info *src, int drec, /* should be always NULL */ dest[i].observer = src[drec].observer; dest[i].pre_unwrapped = 0; + dest[i].env_already = 0; } } @@ -4581,6 +4582,7 @@ void scheme_init_expand_recs(Scheme_Expand_Info *src, int drec, dest[i].certs = src[drec].certs; dest[i].observer = src[drec].observer; dest[i].pre_unwrapped = 0; + dest[i].env_already = 0; } } @@ -4603,6 +4605,7 @@ void scheme_init_lambda_rec(Scheme_Compile_Info *src, int drec, lam[dlrec].certs = src[drec].certs; lam[dlrec].observer = src[drec].observer; lam[dlrec].pre_unwrapped = 0; + lam[dlrec].env_already = 0; } void scheme_merge_lambda_rec(Scheme_Compile_Info *src, int drec, @@ -4850,6 +4853,7 @@ static void *compile_k(void) rec.certs = NULL; rec.observer = NULL; rec.pre_unwrapped = 0; + rec.env_already = 0; cenv = scheme_new_comp_env(genv, insp, SCHEME_TOPLEVEL_FRAME); @@ -6289,7 +6293,7 @@ scheme_compile_expand_block(Scheme_Object *forms, Scheme_Comp_Env *env, if (!SCHEME_STX_SYMBOLP(var)) scheme_wrong_syntax(NULL, var, first, "name must be an identifier"); - scheme_dup_symbol_check(&r, "internal definition", var, "binding", first); + // scheme_dup_symbol_check(&r, "internal definition", var, "binding", first); vars = SCHEME_STX_CDR(vars); cnt++; } @@ -6359,6 +6363,16 @@ scheme_compile_expand_block(Scheme_Object *forms, Scheme_Comp_Env *env, scheme_set_local_syntax(cnt++, a, scheme_false, new_env); } + /* Extend shared rib with renamings */ + scheme_add_env_renames(rib, new_env, env); + + /* Check for duplicates after extending the rib with renamings, + since the renamings properly track marks. */ + for (l = names; SCHEME_STX_PAIRP(l); l = SCHEME_STX_CDR(l)) { + a = SCHEME_STX_CAR(l); + scheme_dup_symbol_check(&r, "internal definition", a, "binding", first); + } + if (!is_val) { /* Evaluate and bind syntaxes */ scheme_prepare_exp_env(new_env->genv); @@ -6371,9 +6385,6 @@ scheme_compile_expand_block(Scheme_Object *forms, Scheme_Comp_Env *env, &pos); } - /* Extend shared rib with renamings */ - scheme_add_env_renames(rib, new_env, env); - /* Remember extended environment */ SCHEME_PTR1_VAL(ctx) = new_env; env = new_env; @@ -6441,6 +6452,9 @@ scheme_compile_expand_block(Scheme_Object *forms, Scheme_Comp_Env *env, } if (!more) { + /* We've converted to a letrec or letrec-values+syntaxes */ + rec[drec].env_already = 1; + if (rec[drec].comp) { result = scheme_compile_expr(result, env, rec, drec); return scheme_make_pair(result, scheme_null); @@ -8720,6 +8734,7 @@ static void *expand_k(void) erec1.certs = certs; erec1.observer = observer; erec1.pre_unwrapped = 0; + erec1.env_already = 0; if (catch_lifts_key) scheme_frame_captures_lifts(env, scheme_make_lifted_defn, scheme_sys_wraps(env), scheme_false, catch_lifts_key); @@ -9201,7 +9216,7 @@ do_local_expand(const char *name, int for_stx, int catch_lifts, int for_expr, in l = scheme_add_rename(l, renaming); if (for_expr) { - /* Package up expanded expr with the enviornment. */ + /* Package up expanded expr with the environment. */ while (1) { if (orig_env->flags & SCHEME_FOR_STOPS) orig_env = orig_env->next; @@ -9552,6 +9567,7 @@ local_eval(int argc, Scheme_Object **argv) rec.certs = certs; rec.observer = observer; rec.pre_unwrapped = 0; + rec.env_already = 0; /* Evaluate and bind syntaxes */ expr = scheme_add_remove_mark(expr, scheme_current_thread->current_local_mark); diff --git a/src/mzscheme/src/module.c b/src/mzscheme/src/module.c index 360e0fa16c..77d3f168c4 100644 --- a/src/mzscheme/src/module.c +++ b/src/mzscheme/src/module.c @@ -5773,6 +5773,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, erec1.certs = rec[drec].certs; erec1.observer = rec[drec].observer; erec1.pre_unwrapped = 0; + erec1.env_already = 0; e = scheme_expand_expr(e, xenv, &erec1, 0); } @@ -5975,6 +5976,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, mrec.certs = rec[drec].certs; mrec.observer = NULL; mrec.pre_unwrapped = 0; + mrec.env_already = 0; if (!rec[drec].comp) { Scheme_Expand_Info erec1; @@ -5984,6 +5986,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, erec1.certs = rec[drec].certs; erec1.observer = rec[drec].observer; erec1.pre_unwrapped = 0; + erec1.env_already = 0; SCHEME_EXPAND_OBSERVE_PHASE_UP(observer); code = scheme_expand_expr_lift_to_let(code, eenv, &erec1, 0); } diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h index 9ea3f36d3a..8cff95e5c6 100644 --- a/src/mzscheme/src/schpriv.h +++ b/src/mzscheme/src/schpriv.h @@ -1837,6 +1837,7 @@ typedef struct Scheme_Compile_Expand_Info char resolve_module_ids; char pre_unwrapped; int depth; + int env_already; } Scheme_Compile_Expand_Info; typedef Scheme_Compile_Expand_Info Scheme_Compile_Info; @@ -2301,6 +2302,7 @@ int *scheme_env_get_flags(Scheme_Comp_Env *frame, int start, int count); #define SCHEME_FOR_STOPS 128 #define SCHEME_FOR_INTDEF 256 #define SCHEME_CAPTURE_LIFTED 512 +#define SCHEME_INTDEF_SHADOW 1024 /* Flags used with scheme_static_distance */ #define SCHEME_ELIM_CONST 1 diff --git a/src/mzscheme/src/stxobj.c b/src/mzscheme/src/stxobj.c index a31ef7c2e1..e24d1a87dd 100644 --- a/src/mzscheme/src/stxobj.c +++ b/src/mzscheme/src/stxobj.c @@ -2982,12 +2982,14 @@ static Scheme_Object *check_floating_id(Scheme_Object *stx) return scheme_false; } -XFORM_NONGCING static int same_marks(WRAP_POS *_awl, WRAP_POS *_bwl, - Scheme_Object *barrier_env, Scheme_Object *ignore_rib) +XFORM_NONGCING static int same_marks(WRAP_POS *_awl, WRAP_POS *_bwl, Scheme_Object *barrier_env) /* Compares the marks in two wraps lists. A result of 2 means that the - result depended on a barrier env. Use #f for barrier_env - to treat no rib envs as barriers; we check for barrier_env only in ribs - because simpliciation eliminates the need for these checks(?). */ + result depended on a barrier env. For a rib-based renaming, we need + to check only up to the rib, and the barrier effect important for + when a rib-based renaming is layered with another renaming (such as + when an internal-definition-base local-expand is used to form a new + set of bindings, as in the unit form); simplification cleans up the + layers, so that we only need to check in ribs. */ { WRAP_POS awl; WRAP_POS bwl; @@ -3015,9 +3017,7 @@ XFORM_NONGCING static int same_marks(WRAP_POS *_awl, WRAP_POS *_bwl, WRAP_POS_INC(awl); } } else if (SCHEME_RIBP(WRAP_POS_FIRST(awl))) { - if (SAME_OBJ(ignore_rib, WRAP_POS_FIRST(awl))) { - WRAP_POS_INC(awl); - } else if (SCHEME_FALSEP(barrier_env)) { + if (SCHEME_FALSEP(barrier_env)) { WRAP_POS_INC(awl); } else { /* See if the barrier environment is in this rib. */ @@ -3054,9 +3054,7 @@ XFORM_NONGCING static int same_marks(WRAP_POS *_awl, WRAP_POS *_bwl, WRAP_POS_INC(bwl); } } else if (SCHEME_RIBP(WRAP_POS_FIRST(bwl))) { - if (SAME_OBJ(ignore_rib, WRAP_POS_FIRST(bwl))) { - WRAP_POS_INC(bwl); - } else if (SCHEME_FALSEP(barrier_env)) { + if (SCHEME_FALSEP(barrier_env)) { WRAP_POS_INC(bwl); } else { /* See if the barrier environment is in this rib. */ @@ -3665,15 +3663,16 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, && !no_lexical)) { /* Lexical rename: */ Scheme_Object *rename, *renamed; - int ri, c, istart, iend, is_rib; + int ri, c, istart, iend; + Scheme_Lexical_Rib *is_rib; if (rib) { rename = rib->rename; + is_rib = rib; rib = rib->next; - is_rib = 1; } else { rename = WRAP_POS_FIRST(wraps); - is_rib = 0; + is_rib = NULL; } c = SCHEME_RENAME_LEN(rename); @@ -3735,7 +3734,7 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, { WRAP_POS w2; WRAP_POS_INIT(w2, ((Scheme_Stx *)renamed)->wraps); - same = same_marks(&w2, &wraps, other_env, WRAP_POS_FIRST(wraps)); + same = same_marks(&w2, &wraps, other_env); if (!same) EXPLAIN(printf("Different marks\n")); } @@ -3755,7 +3754,11 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, o_rename_stack = CONS(CONS(other_env, envname), o_rename_stack); } - rib = NULL; /* skip rest of rib (if any) */ + if (is_rib) { + /* skip rest of rib (if any) and future instances of the same rib */ + rib = NULL; + skip_ribs = add_skip_set(is_rib->timestamp, skip_ribs); + } } break; @@ -4092,7 +4095,7 @@ int scheme_stx_env_bound_eq(Scheme_Object *a, Scheme_Object *b, Scheme_Object *u WRAP_POS bw; WRAP_POS_INIT(aw, ((Scheme_Stx *)a)->wraps); WRAP_POS_INIT(bw, ((Scheme_Stx *)b)->wraps); - if (!same_marks(&aw, &bw, ae, NULL)) + if (!same_marks(&aw, &bw, ae)) return 0; } @@ -4277,7 +4280,7 @@ Scheme_Object *scheme_stx_remove_extra_marks(Scheme_Object *a, Scheme_Object *re WRAP_POS_INIT(aw, ((Scheme_Stx *)a)->wraps); WRAP_POS_INIT(bw, ((Scheme_Stx *)relative_to)->wraps); - if (!same_marks(&aw, &bw, NULL, NULL)) { + if (!same_marks(&aw, &bw, scheme_false)) { Scheme_Object *wraps = ((Scheme_Stx *)relative_to)->wraps; if (uid) { /* Add a rename record: */ @@ -4647,7 +4650,7 @@ static void simplify_lex_renames(Scheme_Object *wraps, Scheme_Hash_Table *lex_ca /* Check marks (now that we have the correct barriers). */ WRAP_POS_INIT(w2, ((Scheme_Stx *)stx)->wraps); - if (!same_marks(&w2, &w, other_env, (Scheme_Object *)init_rib)) { + if (!same_marks(&w2, &w, other_env)) { other_env = NULL; } @@ -4699,7 +4702,7 @@ static void simplify_lex_renames(Scheme_Object *wraps, Scheme_Hash_Table *lex_ca } } else { WRAP_POS_INIT(w2, ((Scheme_Stx *)stx)->wraps); - if (same_marks(&w2, &w, scheme_false, (Scheme_Object *)init_rib)) + if (same_marks(&w2, &w, scheme_false)) ok = SCHEME_VEC_ELS(v)[0]; else ok = NULL; @@ -6759,7 +6762,7 @@ static Scheme_Object *syntax_original_p(int argc, Scheme_Object **argv) WRAP_POS_INIT(awl, stx->wraps); WRAP_POS_INIT_END(ewl); - if (same_marks(&awl, &ewl, scheme_false, NULL)) + if (same_marks(&awl, &ewl, scheme_false)) return scheme_true; else return scheme_false; diff --git a/src/mzscheme/src/syntax.c b/src/mzscheme/src/syntax.c index f3819089de..4a1e6a4546 100644 --- a/src/mzscheme/src/syntax.c +++ b/src/mzscheme/src/syntax.c @@ -4092,6 +4092,7 @@ gen_let_syntax (Scheme_Object *form, Scheme_Comp_Env *origenv, char *formname, Scheme_Object *first = NULL; Scheme_Compiled_Let_Value *last = NULL, *lv; DupCheckRecord r; + int rec_env_already = rec[drec].env_already; i = scheme_stx_proper_list_length(form); if (i < 3) @@ -4160,8 +4161,14 @@ gen_let_syntax (Scheme_Object *form, Scheme_Comp_Env *origenv, char *formname, names = MALLOC_N(Scheme_Object *, num_bindings); if (frame_already) frame = frame_already; - else - frame = scheme_new_compilation_frame(num_bindings, 0, origenv, rec[drec].certs); + else { + frame = scheme_new_compilation_frame(num_bindings, + (rec_env_already ? SCHEME_INTDEF_SHADOW : 0), + origenv, + rec[drec].certs); + if (rec_env_already) + frame_already = frame; + } env = frame; recs = MALLOC_N_RT(Scheme_Compile_Info, (num_clauses + 1)); @@ -4172,7 +4179,7 @@ gen_let_syntax (Scheme_Object *form, Scheme_Comp_Env *origenv, char *formname, defname = scheme_check_name_property(form, defname); - if (!star) { + if (!star && !frame_already) { scheme_begin_dup_symbol_check(&r, env); } @@ -4216,7 +4223,7 @@ gen_let_syntax (Scheme_Object *form, Scheme_Comp_Env *origenv, char *formname, names[k++] = name; } - if (!star) { + if (!star && !frame_already) { for (m = pre_k; m < k; m++) { scheme_dup_symbol_check(&r, NULL, names[m], "binding", form); } @@ -4319,6 +4326,7 @@ do_let_expand(Scheme_Object *form, Scheme_Comp_Env *origenv, Scheme_Expand_Info Scheme_Comp_Env *use_env, *env; Scheme_Expand_Info erec1; DupCheckRecord r; + int rec_env_already = erec[drec].env_already; vars = SCHEME_STX_CDR(form); @@ -4385,8 +4393,8 @@ do_let_expand(Scheme_Object *form, Scheme_Comp_Env *origenv, Scheme_Expand_Info } /* Note: no more letstar handling needed after this point */ - - scheme_begin_dup_symbol_check(&r, origenv); + if (!env_already && !rec_env_already) + scheme_begin_dup_symbol_check(&r, origenv); vlist = scheme_null; vs = vars; @@ -4405,15 +4413,18 @@ do_let_expand(Scheme_Object *form, Scheme_Comp_Env *origenv, Scheme_Expand_Info { DupCheckRecord r2; Scheme_Object *names = name; - scheme_begin_dup_symbol_check(&r2, origenv); + if (!env_already && !rec_env_already) + scheme_begin_dup_symbol_check(&r2, origenv); while (SCHEME_STX_PAIRP(names)) { name = SCHEME_STX_CAR(names); scheme_check_identifier(NULL, name, NULL, origenv, form); vlist = cons(name, vlist); - scheme_dup_symbol_check(&r2, NULL, name, "clause binding", form); - scheme_dup_symbol_check(&r, NULL, name, "binding", form); + if (!env_already && !rec_env_already) { + scheme_dup_symbol_check(&r2, NULL, name, "clause binding", form); + scheme_dup_symbol_check(&r, NULL, name, "binding", form); + } names = SCHEME_STX_CDR(names); } @@ -4430,7 +4441,10 @@ do_let_expand(Scheme_Object *form, Scheme_Comp_Env *origenv, Scheme_Expand_Info if (env_already) env = env_already; else - env = scheme_add_compilation_frame(vlist, origenv, 0, erec[drec].certs); + env = scheme_add_compilation_frame(vlist, + origenv, + (rec_env_already ? SCHEME_INTDEF_SHADOW : 0), + erec[drec].certs); if (letrec) use_env = env; @@ -5526,6 +5540,7 @@ do_define_syntaxes_syntax(Scheme_Object *form, Scheme_Comp_Env *env, rec1.certs = rec[drec].certs; rec1.observer = NULL; rec1.pre_unwrapped = 0; + rec1.env_already = 0; if (for_stx) { names = defn_targets_syntax(names, exp_env, &rec1, 0); @@ -5717,6 +5732,7 @@ void scheme_bind_syntaxes(const char *where, Scheme_Object *names, Scheme_Object mrec.certs = certs; mrec.observer = NULL; mrec.pre_unwrapped = 0; + mrec.env_already = 0; a = scheme_compile_expr_lift_to_let(a, eenv, &mrec, 0); @@ -5805,9 +5821,11 @@ do_letrec_syntaxes(const char *where, Scheme_Object *form, *bindings, *var_bindings, *body, *v; Scheme_Object *names_to_disappear; Scheme_Comp_Env *stx_env, *var_env, *rhs_env; - int cnt, stx_cnt, var_cnt, i, j, depth, saw_var; + int cnt, stx_cnt, var_cnt, i, j, depth, saw_var, env_already; DupCheckRecord r; + env_already = rec[drec].env_already; + form = SCHEME_STX_CDR(forms); if (!SCHEME_STX_PAIRP(form)) scheme_wrong_syntax(NULL, NULL, forms, NULL); @@ -5823,7 +5841,10 @@ do_letrec_syntaxes(const char *where, scheme_rec_add_certs(rec, drec, forms); - stx_env = scheme_new_compilation_frame(0, 0, origenv, rec[drec].certs); + if (env_already) + stx_env = origenv; + else + stx_env = scheme_new_compilation_frame(0, 0, origenv, rec[drec].certs); rhs_env = stx_env; @@ -5846,8 +5867,8 @@ do_letrec_syntaxes(const char *where, else names_to_disappear = NULL; - - scheme_begin_dup_symbol_check(&r, stx_env); + if (!env_already) + scheme_begin_dup_symbol_check(&r, stx_env); /* Pass 1: Check and Rename */ @@ -5881,8 +5902,10 @@ do_letrec_syntaxes(const char *where, for (l = SCHEME_STX_CAR(a); SCHEME_STX_PAIRP(l); l = SCHEME_STX_CDR(l)) { a = SCHEME_STX_CAR(l); - scheme_check_identifier(where, a, NULL, stx_env, forms); - scheme_dup_symbol_check(&r, where, a, "binding", forms); + if (!env_already) { + scheme_check_identifier(where, a, NULL, stx_env, forms); + scheme_dup_symbol_check(&r, where, a, "binding", forms); + } cnt++; } if (i) @@ -5895,30 +5918,35 @@ do_letrec_syntaxes(const char *where, var_cnt = cnt - stx_cnt; } - scheme_add_local_syntax(stx_cnt, stx_env); - if (saw_var) - var_env = scheme_new_compilation_frame(var_cnt, 0, stx_env, rec[drec].certs); - else + if (!env_already) + scheme_add_local_syntax(stx_cnt, stx_env); + + if (saw_var) { + var_env = scheme_new_compilation_frame(var_cnt, + (env_already ? SCHEME_INTDEF_SHADOW : 0), + stx_env, + rec[drec].certs); + } else var_env = NULL; - for (i = 0; i < (var_env ? 2 : 1) ; i++) { + for (i = (env_already ? 1 : 0); i < (var_env ? 2 : 1) ; i++) { cnt = (i ? var_cnt : stx_cnt); if (cnt > 0) { - /* Add new syntax names to the environment: */ + /* Add new syntax/variable names to the environment: */ j = 0; for (v = (i ? var_bindings : bindings); SCHEME_STX_PAIRP(v); v = SCHEME_STX_CDR(v)) { - Scheme_Object *a, *l; + Scheme_Object *a, *l; - a = SCHEME_STX_CAR(v); - for (l = SCHEME_STX_CAR(a); SCHEME_STX_PAIRP(l); l = SCHEME_STX_CDR(l)) { - a = SCHEME_STX_CAR(l); - if (i) { - /* In compile mode, this will get re-written by the letrec compiler. - But that's ok. We need it now for env_renames. */ - scheme_add_compilation_binding(j++, a, var_env); - } else - scheme_set_local_syntax(j++, a, NULL, stx_env); - } + a = SCHEME_STX_CAR(v); + for (l = SCHEME_STX_CAR(a); SCHEME_STX_PAIRP(l); l = SCHEME_STX_CDR(l)) { + a = SCHEME_STX_CAR(l); + if (i) { + /* In compile mode, this will get re-written by the letrec compiler. + But that's ok. We need it now for env_renames. */ + scheme_add_compilation_binding(j++, a, var_env); + } else + scheme_set_local_syntax(j++, a, NULL, stx_env); + } } } } @@ -5949,29 +5977,31 @@ do_letrec_syntaxes(const char *where, scheme_prepare_exp_env(stx_env->genv); - i = 0; + if (!env_already) { + i = 0; - for (v = bindings; SCHEME_STX_PAIRP(v); v = SCHEME_STX_CDR(v)) { - Scheme_Object *a, *names; + for (v = bindings; SCHEME_STX_PAIRP(v); v = SCHEME_STX_CDR(v)) { + Scheme_Object *a, *names; - SCHEME_EXPAND_OBSERVE_NEXT(rec[drec].observer); + SCHEME_EXPAND_OBSERVE_NEXT(rec[drec].observer); - a = SCHEME_STX_CAR(v); - names = SCHEME_STX_CAR(a); - a = SCHEME_STX_CDR(a); - a = SCHEME_STX_CAR(a); + a = SCHEME_STX_CAR(v); + names = SCHEME_STX_CAR(a); + a = SCHEME_STX_CDR(a); + a = SCHEME_STX_CAR(a); - scheme_bind_syntaxes(where, names, a, - stx_env->genv->exp_env, - stx_env->insp, - rec, drec, - stx_env, rhs_env, - &i); + scheme_bind_syntaxes(where, names, a, + stx_env->genv->exp_env, + stx_env->insp, + rec, drec, + stx_env, rhs_env, + &i); + } } SCHEME_EXPAND_OBSERVE_NEXT_GROUP(rec[drec].observer); - if (names_to_disappear) { + if (!env_already && names_to_disappear) { /* Need to add renaming for disappeared bindings. If they originated for internal definitions, then we need both pre-renamed and renamed, since some might have been