From 9d0f9f7a0572542c427d57793010bde12d5d8fd7 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 20 Oct 2008 13:13:42 +0000 Subject: [PATCH] fix problem with transferring marks when some marks contirbuted to the generation of a module-level binding svn: r12071 --- src/mzscheme/src/env.c | 13 ++++-- src/mzscheme/src/eval.c | 8 ++-- src/mzscheme/src/module.c | 28 ++++++------- src/mzscheme/src/schpriv.h | 3 +- src/mzscheme/src/stxobj.c | 81 ++++++++++++++++++++++++++------------ src/mzscheme/src/syntax.c | 4 +- 6 files changed, 88 insertions(+), 49 deletions(-) diff --git a/src/mzscheme/src/env.c b/src/mzscheme/src/env.c index e49d9bb5f4..0bb16801d1 100644 --- a/src/mzscheme/src/env.c +++ b/src/mzscheme/src/env.c @@ -1743,7 +1743,8 @@ Scheme_Object *scheme_hash_module_variable(Scheme_Env *env, Scheme_Object *modid return val; } -Scheme_Object *scheme_tl_id_sym(Scheme_Env *env, Scheme_Object *id, Scheme_Object *bdg, int is_def, Scheme_Object *phase) +Scheme_Object *scheme_tl_id_sym(Scheme_Env *env, Scheme_Object *id, Scheme_Object *bdg, int is_def, + Scheme_Object *phase, int *_skipped) /* The `env' argument can actually be a hash table. */ { Scheme_Object *marks = NULL, *sym, *map, *l, *a, *amarks, *m, *best_match, *cm, *abdg; @@ -1752,6 +1753,9 @@ Scheme_Object *scheme_tl_id_sym(Scheme_Env *env, Scheme_Object *id, Scheme_Objec sym = SCHEME_STX_SYM(id); + if (_skipped) + *_skipped = 0; + if (SCHEME_HASHTP((Scheme_Object *)env)) marked_names = (Scheme_Hash_Table *)env; else { @@ -1951,6 +1955,9 @@ Scheme_Object *scheme_tl_id_sym(Scheme_Env *env, Scheme_Object *id, Scheme_Objec scheme_hash_set(rev_ht, best_match, scheme_true); } } + } else { + if (_skipped) + *_skipped = best_match_skipped; } return best_match; @@ -2515,7 +2522,7 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags, if (SAME_OBJ(modidx, scheme_undefined)) { if (!env->genv->module && SCHEME_STXP(find_id)) { /* Looks like lexically bound, but double-check that it's not bound via a tl_id: */ - find_global_id = scheme_tl_id_sym(env->genv, find_id, NULL, 0, NULL); + find_global_id = scheme_tl_id_sym(env->genv, find_id, NULL, 0, NULL, NULL); if (!SAME_OBJ(find_global_id, SCHEME_STX_VAL(find_id))) modidx = NULL; /* yes, it is bound */ } @@ -2582,7 +2589,7 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags, *_menv = genv; if (!modname && SCHEME_STXP(find_id)) - find_global_id = scheme_tl_id_sym(env->genv, find_id, NULL, 0, NULL); + find_global_id = scheme_tl_id_sym(env->genv, find_id, NULL, 0, NULL, NULL); else find_global_id = find_id; diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c index 1f6e7c342f..70e2c235a7 100644 --- a/src/mzscheme/src/eval.c +++ b/src/mzscheme/src/eval.c @@ -5435,7 +5435,7 @@ scheme_compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env, /* If form is a marked name, then force #%top binding. This is so temporaries can be used as defined ids. */ Scheme_Object *nm; - nm = scheme_tl_id_sym(env->genv, form, NULL, 0, NULL); + nm = scheme_tl_id_sym(env->genv, form, NULL, 0, NULL, NULL); if (!SAME_OBJ(nm, SCHEME_STX_VAL(form))) { stx = scheme_datum_to_syntax(top_symbol, scheme_false, scheme_sys_wraps(env), 0, 0); @@ -5870,7 +5870,7 @@ static Scheme_Object *check_top(const char *when, Scheme_Object *form, Scheme_Co Scheme_Object *modidx, *symbol = c, *tl_id; int bad; - tl_id = scheme_tl_id_sym(env->genv, symbol, NULL, 0, NULL); + tl_id = scheme_tl_id_sym(env->genv, symbol, NULL, 0, NULL, NULL); if (NOT_SAME_OBJ(tl_id, SCHEME_STX_SYM(symbol))) { /* Since the module has a rename for this id, it's certainly defined. */ } else { @@ -5917,7 +5917,7 @@ top_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, c = check_top(scheme_compile_stx_string, form, env, rec, drec); - c = scheme_tl_id_sym(env->genv, c, NULL, 0, NULL); + c = scheme_tl_id_sym(env->genv, c, NULL, 0, NULL, NULL); if (env->genv->module && !rec[drec].resolve_module_ids) { /* Self-reference in a module; need to remember the modidx. Don't @@ -8954,7 +8954,7 @@ scheme_make_lifted_defn(Scheme_Object *sys_wraps, Scheme_Object **_id, Scheme_Ob Scheme_Object *l; /* Registers marked id: */ - scheme_tl_id_sym(env->genv, *_id, scheme_false, 2, NULL); + scheme_tl_id_sym(env->genv, *_id, scheme_false, 2, NULL, NULL); l = icons(scheme_datum_to_syntax(define_values_symbol, scheme_false, sys_wraps, 0, 0), icons(scheme_make_pair(*_id, scheme_null), diff --git a/src/mzscheme/src/module.c b/src/mzscheme/src/module.c index a22bbff3f0..72ba911c39 100644 --- a/src/mzscheme/src/module.c +++ b/src/mzscheme/src/module.c @@ -3210,7 +3210,7 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object supplied (not both). For unprotected access, both prot_insp and stx+certs should be supplied. */ { - symbol = scheme_tl_id_sym(env, symbol, NULL, 0, NULL); + symbol = scheme_tl_id_sym(env, symbol, NULL, 0, NULL, NULL); if (scheme_is_kernel_env(env) || ((env->module->primitive && !env->module->provide_protects)) @@ -3389,7 +3389,7 @@ Scheme_Object *scheme_module_syntax(Scheme_Object *modname, Scheme_Env *env, Sch if (!menv->et_ran) scheme_run_module_exptime(menv, 1); - name = scheme_tl_id_sym(menv, name, NULL, 0, NULL); + name = scheme_tl_id_sym(menv, name, NULL, 0, NULL, NULL); val = scheme_lookup_in_table(menv->syntax, (char *)name); @@ -5505,7 +5505,7 @@ static int check_already_required(Scheme_Hash_Table *required, Scheme_Object *na static Scheme_Object *stx_sym(Scheme_Object *name, Scheme_Object *_genv) { - return scheme_tl_id_sym((Scheme_Env *)_genv, name, NULL, 2, NULL); + return scheme_tl_id_sym((Scheme_Env *)_genv, name, NULL, 2, NULL, NULL); } static Scheme_Object *add_a_rename(Scheme_Object *fm, Scheme_Object *post_ex_rn) @@ -5546,7 +5546,7 @@ static Scheme_Object *add_lifted_defn(Scheme_Object *data, Scheme_Object **_id, self_modidx = SCHEME_VEC_ELS(data)[1]; rn = SCHEME_VEC_ELS(data)[2]; - name = scheme_tl_id_sym(env->genv, *_id, scheme_false, 2, NULL); + name = scheme_tl_id_sym(env->genv, *_id, scheme_false, 2, NULL, NULL); /* Create the bucket, indicating that the name will be defined: */ scheme_add_global_symbol(name, scheme_undefined, env->genv); @@ -5848,7 +5848,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, /* Remember the original: */ all_defs = scheme_make_pair(name, all_defs); - name = scheme_tl_id_sym(env->genv, name, NULL, 2, NULL); + name = scheme_tl_id_sym(env->genv, name, NULL, 2, NULL, NULL); /* Check that it's not yet defined: */ if (scheme_lookup_in_table(env->genv->toplevel, (const char *)name)) { @@ -5925,7 +5925,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, else all_et_defs = scheme_make_pair(name, all_et_defs); - name = scheme_tl_id_sym(oenv->genv, name, NULL, 2, NULL); + name = scheme_tl_id_sym(oenv->genv, name, NULL, 2, NULL, NULL); if (scheme_lookup_in_table(oenv->genv->syntax, (const char *)name)) { scheme_wrong_syntax("module", orig_name, e, @@ -6278,7 +6278,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, /* may be a single shadowed exclusion, now bound to exclude_hint... */ n = SCHEME_CAR(n); if (SCHEME_STXP(n)) - n = scheme_tl_id_sym(env->genv, n, NULL, 0, NULL); + n = scheme_tl_id_sym(env->genv, n, NULL, 0, NULL, NULL); n = scheme_hash_get(required, n); if (n && !SAME_OBJ(SCHEME_VEC_ELS(n)[1], kernel_modidx)) { /* there is a single shadowed exclusion. */ @@ -6814,7 +6814,7 @@ int compute_reprovides(Scheme_Hash_Table *all_provided, /* Make sure each excluded name was defined: */ for (exns = exl; !SCHEME_STX_NULLP(exns); exns = SCHEME_STX_CDR(exns)) { a = SCHEME_STX_CAR(exns); - name = scheme_tl_id_sym(genv, a, NULL, 0, NULL); + name = scheme_tl_id_sym(genv, a, NULL, 0, NULL, NULL); if (!scheme_lookup_in_table(genv->toplevel, (const char *)name) && !scheme_lookup_in_table(genv->syntax, (const char *)name)) { scheme_wrong_syntax("module", a, ree_kw, "excluded identifier was not defined"); @@ -6824,12 +6824,12 @@ int compute_reprovides(Scheme_Hash_Table *all_provided, for (adl = all_defs; SCHEME_PAIRP(adl); adl = SCHEME_CDR(adl)) { name = SCHEME_CAR(adl); exname = SCHEME_STX_SYM(name); - name = scheme_tl_id_sym(genv, name, NULL, 0, NULL); + name = scheme_tl_id_sym(genv, name, NULL, 0, NULL, NULL); /* Was this one excluded? */ for (exns = exl; !SCHEME_STX_NULLP(exns); exns = SCHEME_STX_CDR(exns)) { a = SCHEME_STX_CAR(exns); - a = scheme_tl_id_sym(genv, a, NULL, 0, NULL); + a = scheme_tl_id_sym(genv, a, NULL, 0, NULL, NULL); if (SAME_OBJ(a, name)) break; } @@ -6845,7 +6845,7 @@ int compute_reprovides(Scheme_Hash_Table *all_provided, as if it had ree_kw's context, then comparing that result to the actual tl_id. */ a = scheme_datum_to_syntax(exname, scheme_false, ree_kw, 0, 0); - a = scheme_tl_id_sym(genv, a, NULL, 0, NULL); + a = scheme_tl_id_sym(genv, a, NULL, 0, NULL, NULL); if (SAME_OBJ(a, name)) { /* Add prefix, if any */ @@ -7033,7 +7033,7 @@ char *compute_provide_arrays(Scheme_Hash_Table *all_provided, Scheme_Hash_Table prnt_name = name; if (SCHEME_STXP(name)) { if (genv) - name = scheme_tl_id_sym(genv, name, NULL, 0, phase); + name = scheme_tl_id_sym(genv, name, NULL, 0, phase, NULL); else name = SCHEME_STX_VAL(name); /* shouldn't get here; no `define-for-label' */ } @@ -7106,7 +7106,7 @@ char *compute_provide_arrays(Scheme_Hash_Table *all_provided, Scheme_Hash_Table if (genv && (SAME_OBJ(phase, scheme_make_integer(0)) || SAME_OBJ(phase, scheme_make_integer(1)))) - name = scheme_tl_id_sym(genv, name, NULL, 0, phase); + name = scheme_tl_id_sym(genv, name, NULL, 0, phase, NULL); else { name = SCHEME_STX_VAL(name); /* shouldn't get here; no `define-for-label' */ } @@ -8040,7 +8040,7 @@ void add_single_require(Scheme_Module_Exports *me, /* from module */ /* The `require' expression has a set of marks in its context, which means that we need to generate a name. */ iname = scheme_datum_to_syntax(iname, scheme_false, mark_src, 0, 0); - iname = scheme_tl_id_sym(orig_env, iname, scheme_false, 2, to_phase); + iname = scheme_tl_id_sym(orig_env, iname, scheme_false, 2, to_phase, NULL); if (all_simple) *all_simple = 0; } diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h index 8a6b5b270e..0ab5091ff3 100644 --- a/src/mzscheme/src/schpriv.h +++ b/src/mzscheme/src/schpriv.h @@ -2634,7 +2634,8 @@ void scheme_add_global_constant_symbol(Scheme_Object *name, Scheme_Object *v, Sc -Scheme_Object *scheme_tl_id_sym(Scheme_Env *env, Scheme_Object *id, Scheme_Object *bdg, int is_def, Scheme_Object *phase); +Scheme_Object *scheme_tl_id_sym(Scheme_Env *env, Scheme_Object *id, Scheme_Object *bdg, int is_def, + Scheme_Object *phase, int *_skipped); int scheme_tl_id_is_sym_used(Scheme_Hash_Table *marked_names, Scheme_Object *sym); Scheme_Object *scheme_sys_wraps(Scheme_Comp_Env *env); diff --git a/src/mzscheme/src/stxobj.c b/src/mzscheme/src/stxobj.c index 31ec03d690..95fc7830c3 100644 --- a/src/mzscheme/src/stxobj.c +++ b/src/mzscheme/src/stxobj.c @@ -3300,7 +3300,7 @@ static int explain_resolves = 0; static Scheme_Object *resolve_env(WRAP_POS *_wraps, Scheme_Object *a, Scheme_Object *orig_phase, int w_mod, Scheme_Object **get_names, - Scheme_Object *skip_ribs) + Scheme_Object *skip_ribs, int *_binding_marks_skipped) /* Module binding ignored if w_mod is 0. If module bound, result is module idx, and get_names[0] is set to source name, get_names[1] is set to the nominal source module, get_names[2] is set to @@ -3321,6 +3321,7 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, Scheme_Object *phase = orig_phase; Scheme_Object *bdg = NULL, *floating = NULL; Scheme_Hash_Table *export_registry = NULL; + int mresult_skipped = 0; EXPLAIN(printf("Resolving %s [skips: %s]:\n", SCHEME_SYM_VAL(SCHEME_STX_VAL(a)), scheme_write_to_string(skip_ribs ? skip_ribs : scheme_false, NULL))); @@ -3370,10 +3371,12 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, } stack_pos -= 2; } - if (!did_lexical) + if (!did_lexical) { result = mresult; - else if (get_names) - get_names[0] = scheme_undefined; + if (_binding_marks_skipped) + *_binding_marks_skipped = mresult_skipped; + } else if (get_names) + get_names[0] = scheme_undefined; EXPLAIN(printf("Result: %s\n", scheme_write_to_string(result, 0))); @@ -3383,6 +3386,7 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, && w_mod) { /* Module rename: */ Module_Renames *mrn; + int skipped; EXPLAIN(printf("Rename/set\n")); @@ -3415,7 +3419,7 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, if (mrn->marked_names) { /* Resolve based on rest of wraps: */ if (!bdg) { - bdg = resolve_env(&wraps, a, orig_phase, 0, NULL, skip_ribs); + bdg = resolve_env(&wraps, a, orig_phase, 0, NULL, skip_ribs, NULL); if (SCHEME_FALSEP(bdg)) { if (!floating_checked) { floating = check_floating_id(a); @@ -3425,7 +3429,7 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, } } /* Remap id based on marks and rest-of-wraps resolution: */ - glob_id = scheme_tl_id_sym((Scheme_Env *)mrn->marked_names, a, bdg, 0, NULL); + glob_id = scheme_tl_id_sym((Scheme_Env *)mrn->marked_names, a, bdg, 0, NULL, &skipped); if (SCHEME_TRUEP(bdg) && !SAME_OBJ(glob_id, SCHEME_STX_VAL(a))) { /* Even if this module doesn't match, the lex-renamed id @@ -3437,8 +3441,10 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, stack_pos = 0; o_rename_stack = scheme_null; } - } else + } else { + skipped = 0; glob_id = SCHEME_STX_VAL(a); + } EXPLAIN(printf(" search %s\n", scheme_write_to_string(glob_id, 0))); @@ -3478,6 +3484,8 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, modidx_shift_from, modidx_shift_to); + mresult_skipped = skipped; + if (get_names) { int no_shift = 0; @@ -3551,6 +3559,7 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, } } else { mresult = scheme_false; + mresult_skipped = 0; if (get_names) get_names[0] = NULL; } @@ -3647,7 +3656,7 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, if (SCHEME_VOIDP(other_env)) { SCHEME_USE_FUEL(1); - other_env = resolve_env(NULL, renamed, 0, 0, NULL, recur_skip_ribs); + other_env = resolve_env(NULL, renamed, 0, 0, NULL, recur_skip_ribs, NULL); if (!is_rib) SCHEME_VEC_ELS(rename)[2+c+ri] = other_env; SCHEME_USE_FUEL(1); @@ -3806,13 +3815,13 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_ if (mrn->needs_unmarshal) { /* Use resolve_env to trigger unmarshal, so that we don't have to implement top/from shifts here: */ - resolve_env(NULL, a, orig_phase, 1, NULL, NULL); + resolve_env(NULL, a, orig_phase, 1, NULL, NULL, NULL); } if (mrn->marked_names) { /* Resolve based on rest of wraps: */ if (!bdg) - bdg = resolve_env(&wraps, a, orig_phase, 0, NULL, NULL); + bdg = resolve_env(&wraps, a, orig_phase, 0, NULL, NULL, NULL); if (SCHEME_FALSEP(bdg)) { if (!floating_checked) { floating = check_floating_id(a); @@ -3821,7 +3830,7 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_ bdg = floating; } /* Remap id based on marks and rest-of-wraps resolution: */ - glob_id = scheme_tl_id_sym((Scheme_Env *)mrn->marked_names, a, bdg, 0, NULL); + glob_id = scheme_tl_id_sym((Scheme_Env *)mrn->marked_names, a, bdg, 0, NULL, NULL); } else glob_id = SCHEME_STX_VAL(a); @@ -3892,8 +3901,8 @@ int scheme_stx_module_eq2(Scheme_Object *a, Scheme_Object *b, Scheme_Object *pha if ((a == asym) || (b == bsym)) return 1; - a = resolve_env(NULL, a, phase, 1, NULL, NULL); - b = resolve_env(NULL, b, phase, 1, NULL, NULL); + a = resolve_env(NULL, a, phase, 1, NULL, NULL, NULL); + b = resolve_env(NULL, b, phase, 1, NULL, NULL, NULL); if (SAME_TYPE(SCHEME_TYPE(a), scheme_module_index_type)) a = scheme_module_resolve(a, 0); @@ -3935,7 +3944,7 @@ Scheme_Object *scheme_stx_module_name(Scheme_Object **a, Scheme_Object *phase, names[4] = NULL; names[5] = NULL; - modname = resolve_env(NULL, *a, phase, 1, names, NULL); + modname = resolve_env(NULL, *a, phase, 1, names, NULL, NULL); if (names[0]) { if (SAME_OBJ(names[0], scheme_undefined)) { @@ -3966,7 +3975,7 @@ Scheme_Object *scheme_stx_moduleless_env(Scheme_Object *a) if (SCHEME_STXP(a)) { Scheme_Object *r; - r = resolve_env(NULL, a, scheme_make_integer(0), 0, NULL, NULL); + r = resolve_env(NULL, a, scheme_make_integer(0), 0, NULL, NULL, NULL); if (SCHEME_FALSEP(r)) r = check_floating_id(a); @@ -3998,13 +4007,13 @@ int scheme_stx_env_bound_eq(Scheme_Object *a, Scheme_Object *b, Scheme_Object *u if (!SAME_OBJ(asym, bsym)) return 0; - ae = resolve_env(NULL, a, phase, 0, NULL, NULL); + ae = resolve_env(NULL, a, phase, 0, NULL, NULL, NULL); /* No need to module_resolve ae, because we ignored module renamings. */ if (uid) be = uid; else { - be = resolve_env(NULL, b, phase, 0, NULL, NULL); + be = resolve_env(NULL, b, phase, 0, NULL, NULL, NULL); /* No need to module_resolve be, because we ignored module renamings. */ } @@ -4034,7 +4043,7 @@ int scheme_stx_bound_eq(Scheme_Object *a, Scheme_Object *b, Scheme_Object *phase Scheme_Object *scheme_explain_resolve_env(Scheme_Object *a) { explain_resolves++; - a = resolve_env(NULL, a, 0, 0, NULL, NULL); + a = resolve_env(NULL, a, 0, 0, NULL, NULL, NULL); --explain_resolves; return a; } @@ -4567,7 +4576,7 @@ static void simplify_lex_renames(Scheme_Object *wraps, Scheme_Hash_Table *lex_ca other_env = SCHEME_VEC_ELS(v)[2+vvsize+ii]; if (SCHEME_VOIDP(other_env)) { - other_env = resolve_env(NULL, stx, 0, 0, NULL, skip_ribs); + other_env = resolve_env(NULL, stx, 0, 0, NULL, skip_ribs, NULL); SCHEME_VEC_ELS(v)[2+vvsize+ii] = other_env; } @@ -6788,7 +6797,7 @@ static Scheme_Object *delta_introducer(int argc, struct Scheme_Object *argv[], S static Scheme_Object *syntax_transfer_intro(int argc, Scheme_Object **argv) { - Scheme_Object *m1, *m2, *delta, *a[1]; + Scheme_Object *orig_m1, *m1, *m2, *delta, *a[1]; int l1, l2; if (!SCHEME_STXP(argv[0])) @@ -6797,6 +6806,7 @@ static Scheme_Object *syntax_transfer_intro(int argc, Scheme_Object **argv) scheme_wrong_type("make-syntax-delta-introducer", "syntax", 1, argc, argv); m1 = scheme_stx_extract_marks(argv[0]); + orig_m1 = m1; m2 = scheme_stx_extract_marks(argv[1]); l1 = scheme_list_length(m1); @@ -6810,11 +6820,32 @@ static Scheme_Object *syntax_transfer_intro(int argc, Scheme_Object **argv) } if (!scheme_equal(m1, m2)) { - /* tails don't match, so keep all marks */ - while (l1) { - delta = CONS(SCHEME_CAR(m1), delta); - m1 = SCHEME_CDR(m1); - l1--; + /* tails don't match, so keep all marks --- except those that determine a module binding */ + int skipped = 0; + Scheme_Object *phase; + Scheme_Thread *p = scheme_current_thread; + + phase = scheme_make_integer(p->current_local_env + ? p->current_local_env->genv->phase + : 0); + resolve_env(NULL, argv[0], phase, 1, NULL, NULL, &skipped); + + if (skipped) { + /* Just keep the first `skipped' marks. */ + delta = scheme_null; + m1 = orig_m1; + while (skipped) { + delta = CONS(SCHEME_CAR(m1), delta); + m1 = SCHEME_CDR(m1); + skipped--; + } + } else { + /* Keep them all */ + while (l1) { + delta = CONS(SCHEME_CAR(m1), delta); + m1 = SCHEME_CDR(m1); + l1--; + } } } diff --git a/src/mzscheme/src/syntax.c b/src/mzscheme/src/syntax.c index e095659f65..b3534c2053 100644 --- a/src/mzscheme/src/syntax.c +++ b/src/mzscheme/src/syntax.c @@ -1102,7 +1102,7 @@ defn_targets_syntax (Scheme_Object *var, Scheme_Comp_Env *env, Scheme_Compile_In Scheme_Object *name, *pr, *bucket; name = SCHEME_STX_CAR(var); - name = scheme_tl_id_sym(env->genv, name, NULL, 2, NULL); + name = scheme_tl_id_sym(env->genv, name, NULL, 2, NULL, NULL); if (rec[drec].resolve_module_ids || !env->genv->module) { bucket = (Scheme_Object *)scheme_global_bucket(name, env->genv); @@ -5373,7 +5373,7 @@ static Scheme_Object *stx_val(Scheme_Object *name, Scheme_Object *_env) { Scheme_Env *env = (Scheme_Env *)_env; - return scheme_tl_id_sym(env, name, NULL, 2, NULL); + return scheme_tl_id_sym(env, name, NULL, 2, NULL, NULL); } static Scheme_Object *