From 01b5b93cdf4cfb0ba14178f22eb0b1143ef5704f Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Wed, 7 Dec 2011 16:30:06 -0800 Subject: * debug.c (debug): Fix regression: repeat last command by hitting Enter stopped working. This was broken by recent bugfixes in the string splitting functions, which introduced a semantics change. * eval.c (flip_s, vecref_s): New symbol variables. (op_modplace): New places (vecref ...) and (flip ...). Bugfix: dec operator was incrementing. (expand_place): Handle vecref and flip. Bugfix: pop has no third argument and so is now handled by the same case as flip. Bugfix: if a modify form has no third argument, then do not resynthesize it with a nil third argument. (eval_init): Initialize new symbol variables. Register new flip operator. Register new list_vectory function as intrinsic. * lib.c (rplacd): When modifying the cdr field of a lazy cons, then lapse the lazy function to nil! This is needed by user-defined lazy conses, and it makes sense to do it this way rather than put in some explicit interface. (list_vector): New function. * lib.h (list_vector): Declared. --- ChangeLog | 25 +++++++++++++++++++++++++ debug.c | 4 ++-- eval.c | 40 +++++++++++++++++++++++++++++++++------- lib.c | 22 +++++++++++++++++++--- lib.h | 1 + 5 files changed, 80 insertions(+), 12 deletions(-) diff --git a/ChangeLog b/ChangeLog index 6042d04b..37970ac0 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,28 @@ +2011-12-07 Kaz Kylheku + + * debug.c (debug): Fix regression: repeat last command by hitting + Enter stopped working. This was broken by recent bugfixes in the + string splitting functions, which introduced a semantics change. + + * eval.c (flip_s, vecref_s): New symbol variables. + (op_modplace): New places (vecref ...) and (flip ...). Bugfix: dec + operator was incrementing. + (expand_place): Handle vecref and flip. Bugfix: pop has no + third argument and so is now handled by the same case as flip. + Bugfix: if a modify form has no third argument, then do not + resynthesize it with a nil third argument. + (eval_init): Initialize new symbol variables. + Register new flip operator. Register new list_vectory function + as intrinsic. + + * lib.c (rplacd): When modifying the cdr field of a lazy cons, + then lapse the lazy function to nil! This is needed by user-defined + lazy conses, and it makes sense to do it this way rather than + put in some explicit interface. + (list_vector): New function. + + * lib.h (list_vector): Declared. + 2011-12-07 Kaz Kylheku * eval.c (lookup_var, lookup_fun): Reversing assoc arguments. diff --git a/debug.c b/debug.c index 38a4b379..7c48cf24 100644 --- a/debug.c +++ b/debug.c @@ -34,7 +34,6 @@ val debug(val form, val bindings, val data, val line, val chr) val print_data = t; for (;;) { - uses_or2; val input, command; if (print_form) { @@ -58,7 +57,8 @@ val debug(val form, val bindings, val data, val line, val chr) flush_stream(std_output); input = split_str_set(get_line(std_input), lit("\t ")); - command = or2(first(input), last_command); + command = if3(equal(first(input), null_string), + last_command, first(input)); last_command = command; if (equal(command, lit("?")) || equal(command, lit("help"))) { diff --git a/eval.c b/eval.c index 7ecb4ec7..a1823b47 100644 --- a/eval.c +++ b/eval.c @@ -52,7 +52,7 @@ val op_table; val eval_error_s; val progn_s, let_s, let_star_s, lambda_s, call_s; val cond_s, if_s, and_s, or_s, defvar_s, defun_s; -val inc_s, dec_s, push_s, pop_s, gethash_s, car_s, cdr_s; +val inc_s, dec_s, push_s, pop_s, flip_s, gethash_s, car_s, cdr_s, vecref_s; val for_s, for_star_s, dohash_s, uw_protect_s, return_s, return_from_s; val list_s, append_s, apply_s; @@ -544,6 +544,7 @@ static val op_modplace(val form, val env) eval_error(form, lit("unbound variable ~s"), place, nao); loc = cdr_l(binding); } else if (consp(place)) { + /* TODO: dispatch these with hash table. */ val sym = car(place); if (sym == gethash_s) { val hash = eval(second(place), env, form); @@ -558,6 +559,10 @@ static val op_modplace(val form, val env) } else if (sym == car_s) { val cons = eval(second(place), env, form); loc = cdr_l(cons); + } else if (sym == vecref_s) { + val vec = eval(second(place), env, form); + val ind = eval(third(place), env, form); + loc = vecref_l(vec, ind); } else { eval_error(form, lit("~a: ~s is not a recognized place form"), op, place, nao); @@ -578,7 +583,7 @@ static val op_modplace(val form, val env) return *loc = plus(*loc, inc); } else if (op == dec_s) { val inc = or2(newval, num(1)); - return *loc = plus(*loc, inc); + return *loc = minus(*loc, inc); } else if (op == push_s) { if (!third_arg_p) eval_error(form, lit("~a: missing argument"), op, place, nao); @@ -587,9 +592,11 @@ static val op_modplace(val form, val env) if (third_arg_p) eval_error(form, lit("~a: superfluous argument"), op, place, nao); return pop(loc); + } else if (op == flip_s) { + return *loc = nullp(*loc); } - internal_error("unrecognized operator"); + internal_error("unhandled place modifier"); } static val op_for(val form, val env) @@ -738,6 +745,15 @@ static val expand_place(val place) if (cell == cell_ex) return place; return cons(sym, cons(cell_ex, nil)); + } else if (sym == vecref_s) { + val vec = second(place); + val vec_ex = expand(vec); + val ind = third(place); + val ind_ex = expand(ind); + + if (vec == vec_ex && ind == ind_ex) + return place; + return rlcp(cons(sym, cons(vec_ex, cons(ind_ex, nil))), place); } else { eval_error(place, lit("unrecognized place: ~s"), place, nao); } @@ -864,7 +880,7 @@ val expand(val form) if (body == body_ex) return form; return rlcp(cons(sym, cons(name, cons(args, body_ex))), form); - } else if (sym == inc_s || sym == dec_s || sym == push_s || sym == pop_s) { + } else if (sym == inc_s || sym == dec_s || sym == push_s) { val place = second(form); val inc = third(form); val place_ex = expand_place(place); @@ -872,7 +888,15 @@ val expand(val form) if (place == place_ex && inc == inc_x) return form; + if (inc == nil) + return rlcp(cons(sym, cons(place, nil)), form); return rlcp(cons(sym, cons(place, cons(inc_x, nil))), form); + } else if (sym == pop_s || sym == flip_s) { + val place = second(form); + val place_ex = expand_place(place); + if (place == place_ex) + return form; + return rlcp(cons(sym, cons(place, nil)), form); } else if (sym == quote_s || sym == fun_s) { return form; } else if (sym == qquote_s) { @@ -1012,6 +1036,7 @@ void eval_init(void) dec_s = intern(lit("dec"), user_package); push_s = intern(lit("push"), user_package); pop_s = intern(lit("pop"), user_package); + flip_s = intern(lit("flip"), user_package); for_s = intern(lit("for"), user_package); for_star_s = intern(lit("for*"), user_package); dohash_s = intern(lit("dohash"), user_package); @@ -1021,8 +1046,7 @@ void eval_init(void) gethash_s = intern(lit("gethash"), user_package); car_s = intern(lit("car"), user_package); cdr_s = intern(lit("cdr"), user_package); - car_s = intern(lit("car"), user_package); - cdr_s = intern(lit("cdr"), user_package); + vecref_s = intern(lit("vecref"), user_package); list_s = intern(lit("list"), user_package); append_s = intern(lit("append"), user_package); apply_s = intern(lit("apply"), user_package); @@ -1048,6 +1072,7 @@ void eval_init(void) sethash(op_table, set_s, cptr((mem_t *) op_modplace)); sethash(op_table, push_s, cptr((mem_t *) op_modplace)); sethash(op_table, pop_s, cptr((mem_t *) op_modplace)); + sethash(op_table, flip_s, cptr((mem_t *) op_modplace)); sethash(op_table, for_s, cptr((mem_t *) op_for)); sethash(op_table, for_star_s, cptr((mem_t *) op_for)); sethash(op_table, dohash_s, cptr((mem_t *) op_dohash)); @@ -1210,11 +1235,12 @@ void eval_init(void) reg_fun(intern(lit("vector"), user_package), func_n1(vector)); reg_fun(intern(lit("vec-get-fill"), user_package), func_n1(vec_get_fill)); reg_fun(intern(lit("vec-set-fill"), user_package), func_n2(vec_set_fill)); - reg_fun(intern(lit("vecref"), user_package), func_n2(vecref)); + reg_fun(vecref_s, func_n2(vecref)); reg_fun(intern(lit("vec-push"), user_package), func_n2(vec_push)); reg_fun(intern(lit("length-vec"), user_package), func_n1(length_vec)); reg_fun(intern(lit("size-vec"), user_package), func_n1(size_vec)); reg_fun(intern(lit("vector-list"), user_package), func_n1(vector_list)); + reg_fun(intern(lit("list-vector"), user_package), func_n1(list_vector)); reg_fun(intern(lit("assoc"), user_package), func_n2(assoc)); reg_fun(intern(lit("assq"), user_package), func_n2(assq)); diff --git a/lib.c b/lib.c index be23f012..96b0e3c6 100644 --- a/lib.c +++ b/lib.c @@ -222,13 +222,14 @@ val rplaca(val cons, val new_car) } -val rplacd(val cons, val new_car) +val rplacd(val cons, val new_cdr) { switch (type(cons)) { case CONS: - return cons->c.cdr = new_car; + return cons->c.cdr = new_cdr; case LCONS: - return cons->lc.cdr = new_car; + cons->lc.func = nil; + return cons->lc.cdr = new_cdr; default: type_mismatch(lit("~s is not a cons"), cons, nao); } @@ -2408,6 +2409,21 @@ val vector_list(val list) return vec; } +val list_vector(val vec) +{ + list_collect_decl (list, ptail); + int i, len; + + type_check(vec, VEC); + + len = c_num(vec->v.vec[vec_fill]); + + for (i = 0; i < len; i++) + list_collect(ptail, vec->v.vec[i]); + + return list; +} + static val lazy_stream_func(val env, val lcons) { val stream = car(env); diff --git a/lib.h b/lib.h index aa3f9567..019ffb73 100644 --- a/lib.h +++ b/lib.h @@ -473,6 +473,7 @@ val vec_push(val vec, val item); val length_vec(val vec); val size_vec(val vec); val vector_list(val list); +val list_vector(val vector); val lazy_stream_cons(val stream); val lazy_str(val list, val term, val limit); val lazy_str_force_upto(val lstr, val index); -- cgit v1.2.3