diff options
| -rw-r--r-- | ChangeLog | 14 | ||||
| -rw-r--r-- | eval.c | 5 | ||||
| -rw-r--r-- | lib.c | 50 | ||||
| -rw-r--r-- | lib.h | 5 | ||||
| -rw-r--r-- | txr.1 | 38 |
5 files changed, 111 insertions, 1 deletions
@@ -1,3 +1,17 @@ +2012-04-15 Kaz Kylheku <kaz@kylheku.com> + + * 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 <kaz@kylheku.com> * eval.c (eval_init): find-if intrinsic registered. @@ -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)); @@ -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; @@ -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); @@ -6670,13 +6670,46 @@ The input <list> is unmodified, but the returned list may share substructure with it. If no items are removed, it is possible that the return value is <list> itself. -.SS Function remove-if +.SS Functions remq*, remql* and remqual* + +.TP +Syntax: + + (remq* <object> <list>) + (remql* <object> <list>) + (remqual* <object> <list>) + +.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 <predicate-function> <list> : <key-function>) (keep-if <predicate-function> <list> : <key-function>) + (remove-if* <predicate-function> <list> : <key-function>) + (keep-if* <predicate-function> <list> : <key-function>) .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: |