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

redefining non-syntax as syntax pushes a new cell, but allows the old cell to be gced

Browse source
This commit is contained in:
Alex Shinn 2011-03-06 13:43:40 +09:00
parent a14d03b1a3
commit 91914d6739
1 changed files with 19 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
eval.c
View file

@ -104,25 +104,33 @@ sexp sexp_env_global_ref (sexp env, sexp key, sexp dflt) {
sexp sexp_env_define (sexp ctx, sexp env, sexp key, sexp value) {
sexp cell=SEXP_FALSE, res=SEXP_VOID;
sexp_gc_var1(tmp);
for (tmp=sexp_env_bindings(env); sexp_pairp(tmp); tmp=sexp_env_next_cell(tmp))
if (sexp_car(tmp) == key) {
cell = tmp;
break;
}
sexp_gc_var2(ls1, ls2);
if (sexp_immutablep(env)) {
res = sexp_user_exception(ctx, NULL, "immutable binding", key);
} else {
sexp_gc_preserve1(ctx, tmp);
sexp_gc_preserve2(ctx, ls1, ls2);
for (ls1=NULL, ls2=sexp_env_bindings(env); sexp_pairp(ls2);
ls1=ls2, ls2=sexp_env_next_cell(ls2))
if (sexp_car(ls2) == key) {
cell = ls2;
break;
}
if (sexp_truep(cell)) {
if (sexp_immutablep(cell))
if (sexp_immutablep(cell)) {
res = sexp_user_exception(ctx, NULL, "immutable binding", key);
else
} else if ((sexp_corep(value) || sexp_macrop(value))
&& !(sexp_corep(sexp_cdr(cell))
|| sexp_macrop(sexp_cdr(cell)))) {
if (ls1) sexp_env_next_cell(ls1) = sexp_env_next_cell(ls2);
else sexp_env_bindings(env) = sexp_env_next_cell(ls2);
sexp_env_push(ctx, env, ls2, key, value);
} else {
sexp_cdr(cell) = value;
}
} else {
sexp_env_push(ctx, env, tmp, key, value);
sexp_env_push(ctx, env, ls2, key, value);
}
sexp_gc_release1(ctx);
sexp_gc_release2(ctx);
}
return res;
}