* 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.

5 files changed, 111 insertions, 1 deletions

diff --git a/ChangeLog b/ChangeLog
index d8fda790..b44a9c11 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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.
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 <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: