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

fix problem in local-expand and references to not-yet-bound identifiers

Browse Source 
svn: r13097
This commit is contained in:
Matthew Flatt 2009-01-13 23:28:34 +00:00
parent 5ca04f3497
commit 678f6773aa
4 changed files with 21 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/mzscheme/src/env.c
View File

@ -2609,6 +2609,8 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
if (SCHEME_FALSEP(val)) {
/* Corresponds to a run-time binding (but will be replaced later
through a renaming to a different binding) */
if (flags & SCHEME_OUT_OF_CONTEXT_LOCAL)
return scheme_make_local(scheme_local_type, 0, 0);
return NULL;
}
@ -2647,6 +2649,8 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
if (!(flags & SCHEME_OUT_OF_CONTEXT_OK))
scheme_wrong_syntax(scheme_compile_stx_string, NULL, find_id,
"identifier used out of context");
if (flags & SCHEME_OUT_OF_CONTEXT_LOCAL)
return scheme_make_local(scheme_local_type, 0, 0);
return NULL;
}
}

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

@ -5379,7 +5379,7 @@ scheme_compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
? SCHEME_RESOLVE_MODIDS
: 0)
+ ((!rec[drec].comp && (rec[drec].depth == -2))
? SCHEME_OUT_OF_CONTEXT_OK
? (SCHEME_OUT_OF_CONTEXT_OK | SCHEME_OUT_OF_CONTEXT_LOCAL)
: 0),
rec[drec].certs, env->in_modidx,
&menv, &protected, &lexical_binding_id);
@ -5486,7 +5486,7 @@ scheme_compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
? SCHEME_RESOLVE_MODIDS
: 0)
+ ((!rec[drec].comp && (rec[drec].depth == -2))
? SCHEME_OUT_OF_CONTEXT_OK
? (SCHEME_OUT_OF_CONTEXT_OK | SCHEME_OUT_OF_CONTEXT_LOCAL)
: 0),
erec1.certs, env->in_modidx,
&menv, NULL, NULL);
@ -5572,7 +5572,7 @@ scheme_compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
+ SCHEME_APP_POS + SCHEME_ENV_CONSTANTS_OK
+ SCHEME_DONT_MARK_USE
+ ((!rec[drec].comp && (rec[drec].depth == -2))
? SCHEME_OUT_OF_CONTEXT_OK
? (SCHEME_OUT_OF_CONTEXT_OK | SCHEME_OUT_OF_CONTEXT_LOCAL)
: 0),
rec[drec].certs, env->in_modidx,
&menv, NULL, NULL);
@ -5615,7 +5615,7 @@ scheme_compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
+ SCHEME_APP_POS + SCHEME_ENV_CONSTANTS_OK
+ SCHEME_DONT_MARK_USE
+ ((!rec[drec].comp && (rec[drec].depth == -2))
? SCHEME_OUT_OF_CONTEXT_OK
? (SCHEME_OUT_OF_CONTEXT_OK | SCHEME_OUT_OF_CONTEXT_LOCAL)
: 0),
rec[drec].certs, env->in_modidx,
&menv, NULL, NULL);

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

@ -2350,6 +2350,7 @@ int *scheme_env_get_flags(Scheme_Comp_Env *frame, int start, int count);
#define SCHEME_RESOLVE_MODIDS 1024
#define SCHEME_NO_CERT_CHECKS 2048
#define SCHEME_REFERENCING 4096
#define SCHEME_OUT_OF_CONTEXT_LOCAL 8192
Scheme_Hash_Table *scheme_map_constants_to_globals(void);

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

@ -3109,6 +3109,14 @@ static Scheme_Object *check_floating_id(Scheme_Object *stx)
return scheme_false;
}
#define EXPLAIN_RESOLVE 0
#if EXPLAIN_RESOLVE
static int explain_resolves = 1;
# define EXPLAIN(x) if (explain_resolves) { x; }
#else
# define EXPLAIN(x) /* empty */
#endif
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
@ -3273,6 +3281,7 @@ static int same_marks(WRAP_POS *_awl, WRAP_POS *_bwl, Scheme_Object *barrier_env
/* Done if both reached the end: */
if (WRAP_POS_END_P(awl) && WRAP_POS_END_P(bwl)) {
EXPLAIN(fprintf(stderr, " %d vs. %d marks\n", a_mark_cnt, b_mark_cnt));
if (a_mark_cnt == b_mark_cnt) {
while (a_mark_cnt--) {
if (!SAME_OBJ(a_mark_stack[a_mark_cnt], b_mark_stack[a_mark_cnt]))
@ -3364,14 +3373,6 @@ static void add_all_marks(Scheme_Object *wraps, Scheme_Hash_Table *marks)
}
}
#define EXPLAIN_RESOLVE 0
#if EXPLAIN_RESOLVE
static int explain_resolves = 0;
# define EXPLAIN(x) if (explain_resolves) { x; }
#else
# define EXPLAIN(x) /* empty */
#endif
static int check_matching_marks(Scheme_Object *p, Scheme_Object *orig_id, Scheme_Object **marks_cache, int depth)
{
int l1, l2;
@ -3898,8 +3899,9 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps,
is_rib = NULL;
}
EXPLAIN(fprintf(stderr, "%d lexical rename (%d) %d%s\n", depth, is_rib ? 1 : 0,
EXPLAIN(fprintf(stderr, "%d lexical rename (%d) %d %s%s\n", depth, is_rib ? 1 : 0,
SCHEME_VEC_SIZE(rename),
SCHEME_SYMBOLP(SCHEME_VEC_ELS(rename)[0]) ? SCHEME_SYM_VAL(SCHEME_VEC_ELS(rename)[0]) : "<simp>",
SCHEME_FALSEP(SCHEME_VEC_ELS(rename)[1]) ? "" : " hash"));
c = SCHEME_RENAME_LEN(rename);