From 2b7fedb79b90f813472205e0ce03bfccc731ad29 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 28 Oct 2011 06:41:47 -0600 Subject: [PATCH] better comment to explain a subtle corner of the expander Also added a minor shortcut for cases where the corner isn't relevant. --- src/racket/src/compenv.c | 8 ++++---- src/racket/src/syntax.c | 37 ++++++++++++++++++++++++++++++------- 2 files changed, 34 insertions(+), 11 deletions(-) diff --git a/src/racket/src/compenv.c b/src/racket/src/compenv.c index 2bd5720e42..30a3528d2d 100644 --- a/src/racket/src/compenv.c +++ b/src/racket/src/compenv.c @@ -1253,11 +1253,11 @@ int scheme_tl_id_is_sym_used(Scheme_Hash_Table *marked_names, Scheme_Object *sym return 0; } -static Scheme_Object *make_uid() +static Scheme_Object *make_uid(int in_rib) { char name[20]; - sprintf(name, "env%d", env_uid_counter++); + sprintf(name, "%cnv%d", in_rib ? 'r' : 'e', env_uid_counter++); return scheme_make_symbol(name); /* uninterned! */ } @@ -1268,7 +1268,7 @@ Scheme_Object *scheme_env_frame_uid(Scheme_Comp_Env *env) if (!env->uid) { Scheme_Object *sym; - sym = make_uid(); + sym = make_uid(env->flags & SCHEME_FOR_INTDEF); env->uid = sym; } return env->uid; @@ -1314,7 +1314,7 @@ static void make_env_renames(Scheme_Comp_Env *env, int rcount, int rstart, int r else uid = env->uids[rstart]; if (!uid) - uid = make_uid(); + uid = make_uid(env->flags & SCHEME_FOR_INTDEF); } } diff --git a/src/racket/src/syntax.c b/src/racket/src/syntax.c index 4fafb0f337..e367b7b01c 100644 --- a/src/racket/src/syntax.c +++ b/src/racket/src/syntax.c @@ -3090,14 +3090,35 @@ int scheme_explain_resolves = 1; # define EXPLAIN(x) /* empty */ #endif +XFORM_NONGCING static int is_from_rib(Scheme_Object *other_env) +{ + /* The symbol for a renaming starts with "e" for a normal one + or "r" for one within a rib. */ + if (SCHEME_SYMBOLP(other_env) && (SCHEME_SYM_VAL(other_env)[0] == 'r')) + return 1; + else + return 0; +} + 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. 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. */ +/* Compares the marks in two wraps lists. The `barrier_env' argument cuts + off the mark list if a rib containing a `barrier_env' renaming is found; + effectively, the barrier causes marks between the first and last instance + of the rib to be discarded, which is how re-expansion correctly matches + uses (perhaps macro-introduced) that have extra marks relative to their + bindings. For example, in + (begin-with-definitions + (define x 1) + (define-syntax-rule (m) x) + (m)) + the expansion of `m' will have an extra mark relative to the binding. That + extra mark shouldn't prevent `(letrec ([x 1]) ...)' from binding the use of + `x' as expansion continues with the result of `begin-with-definitions'. Since + `local-expand' adds the int-def context before and after an expansion, the + extra mark can be discarded when checking the `letrec' layer of marks. + Note that it's ok to just cut off the marks at the ribs, because any + further differences in the mark lists would correspond to different renamings + within the rib. */ { WRAP_POS awl; WRAP_POS bwl; @@ -3111,6 +3132,8 @@ static int same_marks(WRAP_POS *_awl, WRAP_POS *_bwl, Scheme_Object *barrier_env WRAP_POS_COPY(awl, *_awl); WRAP_POS_COPY(bwl, *_bwl); + if (!is_from_rib(barrier_env)) barrier_env = scheme_false; + /* A simple way to compare marks would be to make two lists of marks. The loop below attempts to speed up that process by discovering common and canceled marks early, so they can be