klisp

an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

commit df7b383c12bb4f017eae860196e57bf97cbbb703
parent e8901159d26864060b67cb5d166fb318ac67c30c
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Mon,  4 Apr 2011 21:30:55 -0300

Bugfix: filter didn't copy the list if it was immutable. Added bool flag to check_copy_list to force copy even if immutable.

Diffstat:
Msrc/kgbooleans.c | 2+-
Msrc/kgcontinuations.c | 2+-
Msrc/kgcontrol.c | 4++--
Msrc/kgenv_mut.c | 2+-
Msrc/kgenvironments.c | 2+-
Msrc/kghelpers.h | 11++++++++---
Msrc/kgpairs_lists.c | 4+++-
7 files changed, 17 insertions(+), 10 deletions(-)

diff --git a/src/kgbooleans.c b/src/kgbooleans.c @@ -145,7 +145,7 @@ void Sandp_Sorp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv) TValue sname = xparams[0]; TValue term_bool = xparams[1]; - TValue ls = check_copy_list(K, ksymbol_buf(sname), ptree); + TValue ls = check_copy_list(K, ksymbol_buf(sname), ptree, false); /* This will work even if ls is empty */ TValue new_cont = kmake_continuation(K, kget_cc(K), KNIL, KNIL, do_Sandp_Sorp, diff --git a/src/kgcontinuations.c b/src/kgcontinuations.c @@ -237,7 +237,7 @@ void Slet_cc(klisp_State *K, TValue *xparams, TValue ptree, /* the list of instructions is copied to avoid mutation */ /* MAYBE: copy the evaluation structure, ASK John */ - TValue ls = check_copy_list(K, "$let/cc", objs); + TValue ls = check_copy_list(K, "$let/cc", objs, false); /* this is needed because seq continuation doesn't check for nil sequence */ TValue tail = kcdr(ls); diff --git a/src/kgcontrol.c b/src/kgcontrol.c @@ -74,7 +74,7 @@ void Ssequence(klisp_State *K, TValue *xparams, TValue ptree, TValue denv) } else { /* the list of instructions is copied to avoid mutation */ /* MAYBE: copy the evaluation structure, ASK John */ - TValue ls = check_copy_list(K, "$sequence", ptree); + TValue ls = check_copy_list(K, "$sequence", ptree, false); /* this is needed because seq continuation doesn't check for nil sequence */ /* TODO this could be at least in an inlineable function to @@ -175,7 +175,7 @@ TValue split_check_cond_clauses(klisp_State *K, TValue clauses, */ while(count--) { TValue first = kcar(tail); - TValue copy = check_copy_list(K, "$cond", first); + TValue copy = check_copy_list(K, "$cond", first, false); kset_car(tail, copy); tail = kcdr(tail); } diff --git a/src/kgenv_mut.c b/src/kgenv_mut.c @@ -200,7 +200,7 @@ void SprovideB(klisp_State *K, TValue *xparams, TValue ptree, TValue denv) bind_al1p(K, name, ptree, symbols, body); symbols = check_copy_symbol_list(K, name, symbols); - body = check_copy_list(K, name, body); + body = check_copy_list(K, name, body, false); TValue new_env = kmake_environment(K, denv); /* this will copy the bindings from new_env to denv */ diff --git a/src/kgenvironments.c b/src/kgenvironments.c @@ -263,7 +263,7 @@ void Sbindsp(klisp_State *K, TValue *xparams, TValue ptree, TValue denv) int32_t dummy; int32_t count = check_typed_list(K, "$binds?", "symbol", ksymbolp, true, symbols, &dummy); - symbols = check_copy_list(K, "$binds?", symbols); + symbols = check_copy_list(K, "$binds?", symbols, false); TValue new_cont = kmake_continuation(K, kget_cc(K), KNIL, KNIL, do_bindsp, 2, symbols, i2tv(count)); diff --git a/src/kghelpers.h b/src/kghelpers.h @@ -235,6 +235,9 @@ inline void unmark_tree(klisp_State *K, TValue obj) ** Structure checking and copying */ +/* TODO: move all bools to a flag parameter (with constants like + KCHK_LS_FORCE_COPY, KCHK_ALLOW_CYCLE, KCHK_AVOID_ENCYCLE, etc) */ + /* typed finite list. Structure error should be throw before type errors */ int32_t check_typed_list(klisp_State *K, char *name, char *typename, bool (*typep)(TValue), bool allow_infp, TValue obj, @@ -252,14 +255,16 @@ int32_t check_list(klisp_State *K, char *name, bool allow_infp, /* REFACTOR: return the number of pairs and cycle pairs in two extra params */ /* TODO: add check_copy_typed_list */ /* TODO: remove inline */ +/* check that obj is a list and make a copy if it is not immutable or + force_copy is true */ -/* check that obj is a list and make a copy if it is not immutable */ -inline TValue check_copy_list(klisp_State *K, char *name, TValue obj) +inline TValue check_copy_list(klisp_State *K, char *name, TValue obj, + bool force_copy) { if (ttisnil(obj)) return obj; - if (ttispair(obj) && kis_immutable(obj)) { + if (ttispair(obj) && kis_immutable(obj) && !force_copy) { int32_t dummy; (void)check_list(K, name, true, obj, &dummy); return obj; diff --git a/src/kgpairs_lists.c b/src/kgpairs_lists.c @@ -538,7 +538,9 @@ void filter(klisp_State *K, TValue *xparams, TValue ptree, TValue denv) /* REFACTOR: do this in a single pass */ int32_t cpairs; int32_t pairs = check_list(K, "filter", true, ls, &cpairs); - ls = check_copy_list(K, "filter", ls); + /* force copy even if immutable to allow use of mutation + to filter */ + ls = check_copy_list(K, "filter", ls, true); /* add dummy pair to allow set-cdr! to filter out any pair */ ls = kcons(K, KINERT, ls);