Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-17 01:47:34 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

The environment chain lookup should ignore undefined cells if there

Browse source 
are defined cells available.  This avoids previously undefined values
blocking an export-all import.
This commit is contained in:
Alex Shinn 2013-10-14 08:10:34 +09:00
parent 83262a9dfa
commit 156505e798
1 changed files with 26 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
eval.c
View file

@ -78,25 +78,46 @@ sexp sexp_maybe_wrap_error (sexp ctx, sexp obj) {
/********************** environment utilities ***************************/ /********************** environment utilities ***************************/
/* Look for the first defined instance of the variable. If not found, */
/* return the first undefined instance. */
static sexp sexp_env_cell_loc (sexp env, sexp key, int localp, sexp *varenv) { static sexp sexp_env_cell_loc (sexp env, sexp key, int localp, sexp *varenv) {
sexp ls; sexp ls, undefined = NULL, undefined_env = NULL;
do { do {
#if SEXP_USE_RENAME_BINDINGS #if SEXP_USE_RENAME_BINDINGS
for (ls=sexp_env_renames(env); sexp_pairp(ls); ls=sexp_env_next_cell(ls)) for (ls=sexp_env_renames(env); sexp_pairp(ls); ls=sexp_env_next_cell(ls))
if (sexp_car(ls) == key) { if (sexp_car(ls) == key) {
if (sexp_pairp(sexp_cdr(ls)) && sexp_cdr(sexp_cdr(ls)) == SEXP_UNDEF) {
if (!undefined) {
undefined_env = env;
undefined = sexp_cdr(ls);
}
} else {
if (varenv) *varenv = env; if (varenv) *varenv = env;
return sexp_cdr(ls); return sexp_cdr(ls);
} }
}
#endif #endif
for (ls=sexp_env_bindings(env); sexp_pairp(ls); ls=sexp_env_next_cell(ls)) for (ls=sexp_env_bindings(env); sexp_pairp(ls); ls=sexp_env_next_cell(ls))
if (sexp_car(ls) == key) { if (sexp_car(ls) == key) {
if (sexp_cdr(ls) == SEXP_UNDEF) {
if (!undefined) {
undefined_env = env;
undefined = ls;
}
} else {
if (varenv) *varenv = env; if (varenv) *varenv = env;
return ls; return ls;
} }
}
env = (localp ? NULL : sexp_env_parent(env)); env = (localp ? NULL : sexp_env_parent(env));
} while (env && sexp_envp(env)); } while (env && sexp_envp(env));
if (undefined) {
if (varenv) *varenv = undefined_env;
return undefined;
}
return NULL; return NULL;
} }