From 20a737a17009582fd3022fb2f67e4b472445bc4f Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sun, 15 Apr 2012 15:15:23 -0700 Subject: * eval.c (eval_init): New intrinsic functions remq*, remql*, remqual*, remove-if*, keep-if*. * lib.c (rem_lazy_func, rem_lazy_rec): New static functions. (remq_lazy, remql_lazy, remqual_lazy, remove_if_lazy, keep_if_lazy): New functions. * lib.h (remq_lazy, remql_lazy, remqual_lazy, remove_if_lazy, keep_if_lazy): Declared. * txr.1: New functions documented. --- ChangeLog | 14 ++++++++++++++ eval.c | 5 +++++ lib.c | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++ lib.h | 5 +++++ txr.1 | 38 +++++++++++++++++++++++++++++++++++++- 5 files changed, 111 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index d8fda790..b44a9c11 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,17 @@ +2012-04-15 Kaz Kylheku + + * eval.c (eval_init): New intrinsic functions remq*, remql*, + remqual*, remove-if*, keep-if*. + + * lib.c (rem_lazy_func, rem_lazy_rec): New static functions. + (remq_lazy, remql_lazy, remqual_lazy, remove_if_lazy, + keep_if_lazy): New functions. + + * lib.h (remq_lazy, remql_lazy, remqual_lazy, remove_if_lazy, + keep_if_lazy): Declared. + + * txr.1: New functions documented. + 2012-04-14 Kaz Kylheku * eval.c (eval_init): find-if intrinsic registered. diff --git a/eval.c b/eval.c index 3cacebb5..9caec011 100644 --- a/eval.c +++ b/eval.c @@ -2177,6 +2177,11 @@ void eval_init(void) reg_fun(intern(lit("remqual"), user_package), func_n2(remqual)); reg_fun(intern(lit("remove-if"), user_package), func_n3o(remove_if, 2)); reg_fun(intern(lit("keep-if"), user_package), func_n3o(keep_if, 2)); + reg_fun(intern(lit("remq*"), user_package), func_n2(remq_lazy)); + reg_fun(intern(lit("remql*"), user_package), func_n2(remql_lazy)); + reg_fun(intern(lit("remqual*"), user_package), func_n2(remqual_lazy)); + reg_fun(intern(lit("remove-if*"), user_package), func_n3o(remove_if_lazy, 2)); + reg_fun(intern(lit("keep-if*"), user_package), func_n3o(keep_if_lazy, 2)); reg_fun(intern(lit("tree-find"), user_package), func_n3o(tree_find, 2)); reg_fun(intern(lit("some"), user_package), func_n3o(some_satisfy, 2)); reg_fun(intern(lit("all"), user_package), func_n3o(all_satisfy, 2)); diff --git a/lib.c b/lib.c index 704c0bd0..979a4889 100644 --- a/lib.c +++ b/lib.c @@ -720,6 +720,56 @@ val keep_if(val pred, val list, val key) return out; } +static val rem_lazy_rec(val obj, val list, val env, val func); + +static val rem_lazy_func(val env, val lcons) +{ + cons_bind (pred, list, env); + return rplacd(lcons, rem_lazy_rec(pred, list, env, lcons_fun(lcons))); +} + +static val rem_lazy_rec(val pred, val list, val env, val func) +{ + while (list && funcall1(pred, car(list))) + list = cdr(list); + if (!list) + return nil; + if (!env) + func = func_f1(cons(pred, cdr(list)), rem_lazy_func); + else + rplacd(env, cdr(list)); + return make_half_lazy_cons(func, car(list)); +} + +val remq_lazy(val obj, val list) +{ + return rem_lazy_rec(curry_12_1(eq_f, obj), list, nil, nil); +} + +val remql_lazy(val obj, val list) +{ + return rem_lazy_rec(curry_12_1(eql_f, obj), list, nil, nil); +} + +val remqual_lazy(val obj, val list) +{ + return rem_lazy_rec(curry_12_1(equal_f, obj), list, nil, nil); +} + +val remove_if_lazy(val pred, val list, val key) +{ + uses_or2; + val pred_key = chain(or2(key, identity_f), pred, nao); + return rem_lazy_rec(pred_key, list, nil, nil); +} + +val keep_if_lazy(val pred, val list, val key) +{ + uses_or2; + val pred_key = chain(or2(key, identity_f), pred, null_f, nao); + return rem_lazy_rec(pred_key, list, nil, nil); +} + val tree_find(val obj, val tree, val testfun) { uses_or2; diff --git a/lib.h b/lib.h index ed500b40..a3429221 100644 --- a/lib.h +++ b/lib.h @@ -386,6 +386,11 @@ val remql(val obj, val list); val remqual(val obj, val list); val remove_if(val pred, val list, val key); val keep_if(val pred, val list, val key); +val remq_lazy(val obj, val list); +val remql_lazy(val obj, val list); +val remqual_lazy(val obj, val list); +val remove_if_lazy(val pred, val list, val key); +val keep_if_lazy(val pred, val list, val key); val tree_find(val obj, val tree, val testfun); val some_satisfy(val list, val pred, val key); val all_satisfy(val list, val pred, val key); diff --git a/txr.1 b/txr.1 index 6a84a6be..81583d97 100644 --- a/txr.1 +++ b/txr.1 @@ -6670,13 +6670,46 @@ The input is unmodified, but the returned list may share substructure with it. If no items are removed, it is possible that the return value is itself. -.SS Function remove-if +.SS Functions remq*, remql* and remqual* + +.TP +Syntax: + + (remq* ) + (remql* ) + (remqual* ) + +.TP +Description: + +The remq*, remql* and remqual* functions are lazy versions of +remq, remql and remqual. Rather than computing the entire new list +prior to returning, these functions return a lazy list. + +Caution: these functions can still get into infinite looping behavior. +For instance, in (remql* 0 (repeat '(0))), remql will keep consuming +the 0 values coming out of the infinite list, looking for the first item that +does not have to be deleted, in order to instantiate the first lazy value. + +.TP +Examples: + + ;; Return a list of all the natural numbers, excluding 13, + ;; then take the first 100 of these. + ;; If remql is used, it will loop until memory is exhausted, + ;; because (range 1) is an infinite list. + + [(remql* 13 (range 1)) 0..100] + +.SS Functions remove-if, keep-if, remove-if* and keep-if* .TP Syntax: (remove-if : ) (keep-if : ) + (remove-if* : ) + (keep-if* : ) .TP Description @@ -6696,6 +6729,9 @@ The keep-if function is exactly like remove-if, except the sense of the predicate is inverted. The function keep-if retains those items which remove-if will delete, and removes those that remove-if will preserve. +The remove-if* and keep-if* are like remove-if and keep-if, but +produce lazy lists. + .TP Examples: -- cgit v1.2.3