New funtion related to where function.

* eval.c (eval_init): register intrinsics wheref, whereq,
whereql and wherequal.

* lib.c (wheref_fun): New static function.
(wheref, whereq, whereql, wherequal): New functions.

* lib.h (wheref, whereq, whereql, wherequal): Declared.

* tests/012/seq.tl: New tests.

* txr.1: Documented.

5 files changed, 176 insertions, 0 deletions

diff --git a/eval.c b/eval.c
index 478b1345..a55fdc60 100644
--- a/eval.c
+++ b/eval.c
@@ -7829,6 +7829,10 @@ void eval_init(void)
   reg_fun(intern(lit("contains"), user_package), func_n4o(contains, 2));
   reg_fun(intern(lit("search-all"), user_package), func_n4o(search_all, 2));
   reg_fun(intern(lit("where"), user_package), func_n2(where));
+  reg_fun(intern(lit("wheref"), user_package), func_n1(wheref));
+  reg_fun(intern(lit("whereq"), user_package), func_n1(whereq));
+  reg_fun(intern(lit("whereql"), user_package), func_n1(whereql));
+  reg_fun(intern(lit("wherequal"), user_package), func_n1(wherequal));
   reg_fun(intern(lit("select"), user_package), func_n2(sel));
   reg_fun(intern(lit("reject"), user_package), func_n2(reject));
   reg_fun(intern(lit("relate"), user_package), func_n3o(relate, 2));
diff --git a/lib.c b/lib.c
index 2b246e69..3937fcc4 100644
--- a/lib.c
+++ b/lib.c
@@ -14053,6 +14053,46 @@ val where(val func, val seq)
   }
 }
 
+static val wheref_fun(val func, val seq)
+{
+  val iter = iter_begin(seq);
+  val index = zero;
+
+  for (;;) {
+    if (!iter_more(iter))
+      return nil;
+    if (funcall1(func, iter_item(iter)))
+      break;
+    iter = iter_step(iter);
+    index = succ(index);
+  }
+
+  iter = iter_step(iter);
+  return make_lazy_cons_car_cdr(func_f1(iter, lazy_where_func),
+                                index, func);
+}
+
+val wheref(val func)
+{
+  return func_f1(func, wheref_fun);
+}
+
+
+val whereq(val obj)
+{
+  return func_f1(pa_12_1(eq_f, obj), wheref_fun);
+}
+
+val whereql(val obj)
+{
+  return func_f1(pa_12_1(eql_f, obj), wheref_fun);
+}
+
+val wherequal(val obj)
+{
+  return func_f1(pa_12_1(equal_f, obj), wheref_fun);
+}
+
 val sel(val seq, val where_in)
 {
   val self = lit("select");
diff --git a/lib.h b/lib.h
index f83d59b0..5cb52990 100644
--- a/lib.h
+++ b/lib.h
@@ -1453,6 +1453,10 @@ val contains(val key, val seq, val testfun, val keyfun);
 val rsearch(val seq, val key, val from, val to);
 val search_all(val seq, val key, val testfun, val keyfun);
 val where(val func, val seq);
+val wheref(val func);
+val whereq(val obj);
+val whereql(val obj);
+val wherequal(val obj);
 val sel(val seq, val where);
 val reject(val seq, val where);
 val relate(val domain_seq, val range_seq, val dfl_val);
diff --git a/tests/012/seq.tl b/tests/012/seq.tl
index 5746939b..45cf2b67 100644
--- a/tests/012/seq.tl
+++ b/tests/012/seq.tl
@@ -1537,3 +1537,42 @@
 (mtest
   (partition "abcdef" '(4 -1)) ("abcd" "e" "f")
   (partition "abcdef" '(4 5)) ("abcd" "e" "f"))
+
+(mtest
+  (where (op eq #\z) "") nil
+  (where (op eq #\z) "abc") nil
+  (where (op eq 'z) #()) nil
+  (where (op eq 'z) #(a b c)) nil
+  (where (op eq 'z) '()) nil
+  (where (op eq 'z) '(a b c)) nil
+  (where (op eq 10) 1..4) nil
+  (where (op eq 10) 1..1) nil)
+
+(mtest
+  (where (op eq #\c) "abcabc") (2 5)
+  (where (op eq 'c) #(a b c a b c)) (2 5)
+  (where (op eq 'c) '(a b c a b c)) (2 5)
+  (where (op eq 3) 0..9) (3))
+
+(mtest
+  [[wheref oddp] '()] nil
+  [[wheref oddp] '(1 2 3 4 5 6)] (0 2 4))
+
+(mtest
+  [(whereq #\c) "abcabc"] (2 5)
+  [(whereq 'c) #(a b c a b c)] (2 5)
+  [(whereq 'c) '(a b c a b c)] (2 5)
+  [(whereq 3) 0..9] (3))
+
+(mtest
+  [(whereql #\c) "abcabc"] (2 5)
+  [(whereq 'c) #(a b c a b c)] (2 5)
+  [(whereql 'c) '(a b c a b c)] (2 5)
+  [(whereql 3) 0..9] (3))
+
+(mtest
+  [(wherequal #xFFFFFFFFFFFFFFFFFFFF) '(#xFFFFFFFFFFFFFFFFFFFF)] (0)
+  [(wherequal 'c) #(a b c a b c)] (2 5)
+  [(wherequal 'c) '(a b c a b c)] (2 5)
+  [(wherequal 3) '(3 3.0 b c a b c)] (0)
+  [(wherequal 3) 0..9] (3))
diff --git a/txr.1 b/txr.1
index 587874a9..5b8a6b2c 100644
--- a/txr.1
+++ b/txr.1
@@ -36777,6 +36777,95 @@ as an argument.  If a
 value is returned, then the zero-based index of
 that element is added to a list. Finally, the list is returned.
 
+.coNP Function @ wheref
+.synb
+.mets (wheref << function)
+.syne
+.desc
+The
+.code wheref
+function is a combinator related to the
+.code where
+function. 
+
+The
+.code wheref
+function returns a function that takes one argument. When a sequence is
+passed to that function, it returns the index positions where
+the sequence elements satisfy the given
+.metn function ,
+which must be capable of taking one argument.
+
+Certain uses of
+.code where
+can be expressed more briefly using
+.codn wheref ,
+according to the following equivalence:
+
+.verb
+  (where f s)  <--> [(wheref f) s]
+.brev
+
+.TP* Example:
+
+.verb
+  ;; partition list of integers by odd, using where:
+
+  [partition 0..10 (op where oddp)]
+  --> ((0) (1 2) (3 4) (5 6) (7 8) (9))
+
+  ;; using wheref
+  [partition 0..10 [wheref oddp]]
+  --> ((0) (1 2) (3 4) (5 6) (7 8) (9))
+.brev
+
+.coNP Functions @, whereq @ whereql and @ wherequal
+.synb
+.mets (whereq << object )
+.mets (whereql << object )
+.mets (wherequal << object )
+.syne
+.desc
+The functions
+.codn whereq ,
+.code whereql
+and
+.code wherequal
+are combinators related to the
+.code where
+function.
+
+The
+.code whereq
+function returns a function that takes one argument. When a sequence is passed
+to that function, it returns the index positions where the elements of
+the sequence are
+.code eq
+to
+.metn object .
+
+The
+.code whereql
+function differs only in that the test is
+.code eql
+rather than
+.codn eq ,
+and the
+.code wherequal
+function uses
+.code equal
+equality.
+
+.TP* Example:
+
+.verb
+  ;; indices where the string has a 'c', using where:
+  (where (op eq #\c) "abcabc") -> (2 5)
+
+  ;; same, using whereq:
+  [(whereq #\c) "abcabc"] -> (2 5)
+.brev
+
 .coNP Function @ rmismatch
 .synb
 .mets (rmismatch < left-seq < right-seq >> [ testfun <> [ keyfun ]])