Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-20 14:19:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

define doesn't overwrite existing imported bindings.

Browse source 
default repl env also imports standard env rather than using it
directly so redefining primitives doesn't affect standard macros.
This commit is contained in:
Alex Shinn 2010-12-26 17:49:23 +09:00
parent 96161ffcf6
commit a9678e5378
2 changed files with 24 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
eval.c
View file

@ -69,18 +69,25 @@ sexp sexp_env_cell (sexp env, sexp key) {
return sexp_env_cell_loc(env, key, NULL);
}
static sexp sexp_env_cell_create (sexp ctx, sexp env, sexp key,
static sexp sexp_env_cell_define (sexp ctx, sexp env, sexp key,
sexp value, sexp *varenv) {
sexp_gc_var1(cell);
cell = sexp_env_cell_loc(env, key, varenv);
if (! cell) {
sexp_gc_preserve1(ctx, cell);
sexp_gc_var2(cell, ls);
while (sexp_env_lambda(env) || sexp_env_syntactic_p(env))
env = sexp_env_parent(env);
sexp_env_push(ctx, env, cell, key, value);
if (varenv) *varenv = env;
sexp_gc_release1(ctx);
for (ls=sexp_env_bindings(env); sexp_pairp(ls); ls=sexp_env_next_cell(ls))
if (sexp_car(ls) == key)
return ls;
sexp_gc_preserve2(ctx, cell, ls);
sexp_env_push(ctx, env, cell, key, value);
sexp_gc_release2(ctx);
return cell;
}
static sexp sexp_env_cell_create (sexp ctx, sexp env, sexp key,
sexp value, sexp *varenv) {
sexp cell = sexp_env_cell_loc(env, key, varenv);
if (!cell) cell = sexp_env_cell_define(ctx, env, key, value, varenv);
return cell;
}
@ -641,7 +648,7 @@ static sexp analyze_define (sexp ctx, sexp x) {
res = SEXP_VOID;
} else {
if (sexp_synclop(name)) name = sexp_synclo_expr(name);
sexp_env_cell_create(ctx, env, name, SEXP_VOID, NULL);
sexp_env_cell_define(ctx, env, name, SEXP_VOID, NULL);
if (sexp_pairp(sexp_cadr(x))) {
tmp = sexp_cons(ctx, sexp_cdadr(x), sexp_cddr(x));
tmp = sexp_cons(ctx, SEXP_VOID, tmp);

10
main.c
View file

@ -86,15 +86,17 @@ static sexp check_exception (sexp ctx, sexp res) {
}
static sexp sexp_load_standard_repl_env (sexp ctx, sexp env, sexp k) {
sexp res = sexp_load_standard_env(ctx, env, k);
sexp e = sexp_load_standard_env(ctx, env, k), res;
#if SEXP_USE_GREEN_THREADS
sexp p = sexp_param_ref(ctx, env, sexp_global(ctx, SEXP_G_CUR_IN_SYMBOL));
sexp p = sexp_param_ref(ctx, e, sexp_global(ctx, SEXP_G_CUR_IN_SYMBOL));
if (sexp_portp(p)) fcntl(sexp_port_fileno(p), F_SETFL, O_NONBLOCK);
p = sexp_param_ref(ctx, env, sexp_global(ctx, SEXP_G_CUR_OUT_SYMBOL));
p = sexp_param_ref(ctx, e, sexp_global(ctx, SEXP_G_CUR_OUT_SYMBOL));
if (sexp_portp(p)) fcntl(sexp_port_fileno(p), F_SETFL, O_NONBLOCK);
p = sexp_param_ref(ctx, env, sexp_global(ctx, SEXP_G_CUR_ERR_SYMBOL));
p = sexp_param_ref(ctx, e, sexp_global(ctx, SEXP_G_CUR_ERR_SYMBOL));
if (sexp_portp(p)) fcntl(sexp_port_fileno(p), F_SETFL, O_NONBLOCK);
#endif
res = sexp_make_env(ctx);
sexp_env_parent(res) = e;
return res;
}