From a9678e53784990dc74e22bf9abe8e75588c2920e Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Sun, 26 Dec 2010 17:49:23 +0900 Subject: [PATCH] define doesn't overwrite existing imported bindings. default repl env also imports standard env rather than using it directly so redefining primitives doesn't affect standard macros. --- eval.c | 29 ++++++++++++++++++----------- main.c | 10 ++++++---- 2 files changed, 24 insertions(+), 15 deletions(-) diff --git a/eval.c b/eval.c index cc54a59b..eb4adb6c 100644 --- a/eval.c +++ b/eval.c @@ -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_define (sexp ctx, sexp env, sexp key, + sexp value, sexp *varenv) { + sexp_gc_var2(cell, ls); + while (sexp_env_lambda(env) || sexp_env_syntactic_p(env)) + env = sexp_env_parent(env); + if (varenv) *varenv = env; + 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_gc_var1(cell); - cell = sexp_env_cell_loc(env, key, varenv); - if (! cell) { - sexp_gc_preserve1(ctx, cell); - 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); - } + 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); diff --git a/main.c b/main.c index 073c64cc..cd89f4ad 100644 --- a/main.c +++ b/main.c @@ -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; }