diff options
| -rw-r--r-- | ChangeLog | 33 | ||||
| -rw-r--r-- | lib.c | 88 | ||||
| -rw-r--r-- | lib.h | 7 | ||||
| -rw-r--r-- | match.c | 18 |
4 files changed, 112 insertions, 34 deletions
@@ -1,3 +1,36 @@ +2011-10-04 Kaz Kylheku <kaz@kylheku.com> + + Bugfixes to the semantics of binding environments, which + were broken in the face of deletions (local, forget). + For some stupid reason, I had written a destructive routine for + removing elements from an association list, and used it + as the basis for the local and forget directives. + + * lib.c (eq_f, car_f): New variables. + (identity_tramp, equal_tramp): Obsolete functions removed. + (apply): Broken function disabled at run time. + (funcall, funcall1, funcall2): Throw meaningful error instead + of aborting. + (alist_remove_test): New static function. + (alist_remove, alist_remove1): Rewritten to be functional + rather than destructive. + (alist_nremove, alist_nremove1): Destructive functions, + using previous implementations of alist and alist_nremove. + (do_sort): Recurses directly rather than via sort. That was + probably why this helper was introduced! + (find, set_diff): New functions. + (obj_init): gc-protect new variables eq_f and car_f, and initialize + them. Initializations for equal_f and identity_f changed to + use equal and identity directly, without the obsolete wrappers. + + * lib.h (eq_f, car_f, alist_nremove, alist_nremove1, + find, set_diff): Declared. + + * match.c (match_line): Use set_diff to determine what bindings + are new, rather than ldiff and ldiff-like logic which break when + the new bindings do not share structure with the old. + (match_files): Likewise. + 2011-10-03 Kaz Kylheku <kaz@kylheku.com> * txr.1: Starte dodcumenting the forgotten merge directive. @@ -71,8 +71,7 @@ val null_string; val nil_string; val null_list; -val identity_f; -val equal_f; +val identity_f, equal_f, eq_f, car_f; val prog_string; @@ -83,14 +82,6 @@ val identity(val obj) return obj; } -static val identity_tramp(val env, val obj) -{ - (void) env; - return identity(obj); -} - -static val equal_tramp(val env, val , val ); - static val code2type(int code) { switch ((type_t) code) { @@ -559,12 +550,6 @@ val cobj_equal_op(val left, val right) return eq(left, right); } -static val equal_tramp(val env, val left, val right) -{ - (void) env; - return equal(left, right); -} - mem_t *chk_malloc(size_t size) { mem_t *ptr = (mem_t *) malloc(size); @@ -1379,6 +1364,8 @@ val apply(val fun, val arglist) { val arg[4], *p = arg; + internal_error("apply is broken crap: fix before using"); + type_check (fun, FUN); type_assert (listp(arglist), @@ -1427,7 +1414,7 @@ val funcall(val fun) case N0: return fun->f.f.n0(); default: - abort(); + uw_throwf(error_s, lit("funcall: wrong number of arguments")); } } @@ -1441,7 +1428,7 @@ val funcall1(val fun, val arg) case N1: return fun->f.f.n1(arg); default: - abort(); + uw_throwf(error_s, lit("funcall1: wrong number of arguments")); } } @@ -1455,7 +1442,7 @@ val funcall2(val fun, val arg1, val arg2) case N2: return fun->f.f.n2(arg1, arg2); default: - abort(); + uw_throwf(error_s, lit("funcall2: wrong number of arguments")); } } @@ -1906,8 +1893,23 @@ val *acons_new_l(val *list, val key, val *new_p) } } +static val alist_remove_test(val item, val key) +{ + return eq(car(item), key); +} + val alist_remove(val list, val keys) { + return set_diff(list, keys, func_n2(alist_remove_test), nil); +} + +val alist_remove1(val list, val key) +{ + return alist_remove(list, cons(key, nil)); +} + +val alist_nremove(val list, val keys) +{ val *plist = &list; while (*plist) { @@ -1920,7 +1922,7 @@ val alist_remove(val list, val keys) return list; } -val alist_remove1(val list, val key) +val alist_nremove1(val list, val key) { val *plist = &list; @@ -2033,8 +2035,8 @@ static val do_sort(val list, val lessfun, val keyfun) list2 = cdr(bisect); *cdr_l(bisect) = nil; - return merge(sort(list, lessfun, keyfun), - sort(list2, lessfun, keyfun), + return merge(do_sort(list, lessfun, keyfun), + do_sort(list2, lessfun, keyfun), lessfun, keyfun); } } @@ -2047,6 +2049,40 @@ val sort(val list, val lessfun, val keyfun) return do_sort(list, lessfun, keyfun); } +val find(val list, val key, val testfun, val keyfun) +{ + for (; list; list = cdr(list)) { + val item = car(list); + val list_key = funcall1(keyfun, item); + + if (funcall2(testfun, key, list_key)) + return item; + } + + return nil; +} + +val set_diff(val list1, val list2, val testfun, val keyfun) +{ + list_collect_decl (out, ptail); + + if (!keyfun) + keyfun = identity_f; + + if (!testfun) + testfun = equal_f; + + for (; list1; list1 = cdr(list1)) { + val item = car(list1); + val list1_key = funcall1(keyfun, item); + + if (!find(list2, list1_key, testfun, keyfun)) + list_collect (ptail, item); + } + + return out; +} + static void obj_init(void) { /* @@ -2057,7 +2093,7 @@ static void obj_init(void) protect(&packages, &system_package, &keyword_package, &user_package, &null_string, &nil_string, - &null_list, &equal_f, + &null_list, &equal_f, &eq_f, &car_f, &identity_f, &prog_string, (val *) 0); @@ -2157,8 +2193,10 @@ static void obj_init(void) args_k = intern(lit("args"), keyword_package); nothrow_k = intern(lit("nothrow"), keyword_package); - equal_f = func_f2(nil, equal_tramp); - identity_f = func_f1(nil, identity_tramp); + equal_f = func_n2(equal); + eq_f = func_n2(eq); + identity_f = func_n1(identity); + car_f = func_n1(car); prog_string = string(progname); } @@ -237,8 +237,7 @@ extern val nothrow_k, args_k; extern val null_string; extern val null_list; /* (nil) */ -extern val identity_f; -extern val equal_f; +extern val identity_f, equal_f, eq_f, car_f; extern const wchar_t *progname; extern val prog_string; @@ -381,6 +380,8 @@ val acons_new(val list, val key, val value); val *acons_new_l(val *list, val key, val *new_p); val alist_remove(val list, val keys); val alist_remove1(val list, val key); +val alist_nremove(val list, val keys); +val alist_nremove1(val list, val key); val copy_cons(val cons); val copy_alist(val list); val mapcar(val fun, val list); @@ -388,6 +389,8 @@ val mapcon(val fun, val list); val mappend(val fun, val list); val merge(val list1, val list2, val lessfun, val keyfun); val sort(val list, val lessfun, val keyfun); +val find(val list, val key, val testfun, val keyfun); +val set_diff(val list1, val list2, val testfun, val keyfun); void obj_print(val obj, val stream); void obj_pprint(val obj, val stream); @@ -519,7 +519,8 @@ static val match_line(val bindings, val specline, val dataline, if (until_pos) { LOG_MATCH("until/last", until_pos); if (sym == last_s) { - last_bindings = ldiff(until_last_bindings, new_bindings); + last_bindings = set_diff(until_last_bindings, + new_bindings, eq_f, car_f); pos = until_pos; } break; @@ -529,10 +530,11 @@ static val match_line(val bindings, val specline, val dataline, } if (new_pos) { + val strictly_new_bindings = set_diff(new_bindings, + bindings, eq_f, car_f); LOG_MATCH("coll", new_pos); - for (iter = new_bindings; iter && iter != bindings; - iter = cdr(iter)) + for (iter = strictly_new_bindings; iter; iter = cdr(iter)) { val binding = car(iter); val existing = assoc(bindings_coll, car(binding)); @@ -1541,8 +1543,8 @@ repeat_spec_same_data: first(files), num(data_lineno), nao); /* Until discards bindings and position, last keeps them. */ if (sym == last_s) { - last_bindings = ldiff(until_last_bindings, new_bindings); - + last_bindings = set_diff(until_last_bindings, + new_bindings, eq_f, car_f); if (success == t) { data = t; } else { @@ -1556,11 +1558,13 @@ repeat_spec_same_data: } if (success) { + val strictly_new_bindings = set_diff(new_bindings, + bindings, eq_f, car_f); + debuglf(spec_linenum, lit("collect matched ~a:~a"), first(files), num(data_lineno), nao); - for (iter = new_bindings; iter && iter != bindings; - iter = cdr(iter)) + for (iter = strictly_new_bindings; iter; iter = cdr(iter)) { val binding = car(iter); val existing = assoc(bindings_coll, car(binding)); |