* eval.c (eval_init): where and sel registered as intrinsics

where and select.

* lib.c (generic_funcall): Support a sequence as an argument
to a sequence.
(where, sel): New functions.

* lib.h (where, sel): Declared.

* txr.1: Documented.

5 files changed, 141 insertions, 5 deletions

diff --git a/ChangeLog b/ChangeLog
index 8c706c2d..77d4a80c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,18 @@
 2014-06-15  Kaz Kylheku  <kaz@kylheku.com>
 
+	* eval.c (eval_init): where and sel registered as intrinsics
+	where and select.
+
+	* lib.c (generic_funcall): Support a sequence as an argument
+	to a sequence.
+	(where, sel): New functions.
+
+	* lib.h (where, sel): Declared.
+
+	* txr.1: Documented.
+
+2014-06-15  Kaz Kylheku  <kaz@kylheku.com>
+
 	Bugfix: range and range* broken when "to" argument is
 	omitted. This was broken in version 89, by the
 	2014-04-08 commit.
diff --git a/eval.c b/eval.c
index 3fcad2d9..50bf22e6 100644
--- a/eval.c
+++ b/eval.c
@@ -3535,6 +3535,8 @@ void eval_init(void)
   reg_fun(intern(lit("replace"), user_package), func_n4o(replace, 2));
   reg_fun(intern(lit("update"), user_package), func_n2(update));
   reg_fun(intern(lit("search"), user_package), func_n4o(search, 2));
+  reg_fun(intern(lit("where"), user_package), func_n2(where));
+  reg_fun(intern(lit("select"), user_package), func_n2(sel));
 
   reg_fun(intern(lit("make-like"), user_package), func_n2(make_like));
   reg_fun(intern(lit("nullify"), user_package), func_n1(nullify));
diff --git a/lib.c b/lib.c
index e8117bf4..788ad875 100644
--- a/lib.c
+++ b/lib.c
@@ -3391,8 +3391,14 @@ val generic_funcall(val fun, val arg[], int nargs)
     case 0:
       uw_throw(error_s, lit("call: missing required arguments"));
     case 1:
-      if (consp(arg[0]))
-        return sub(fun, car(arg[0]), cdr(arg[0]));
+      if (consp(arg[0])) {
+        cons_bind (x, y, arg[0]);
+        if (atom(y))
+          return sub(fun, x, y);
+        return sel(fun, arg[0]);
+      }
+      if (vectorp(arg[0]))
+        return sel(fun, arg[0]);
       return ref(fun, arg[0]);
     case 2:
       return sub(fun, arg[0], arg[1]);
@@ -5303,6 +5309,63 @@ val search(val seq, val key, val testfun, val keyfun)
   return seq;
 }
 
+val where(val seq_in, val func)
+{
+  list_collect_decl (out, ptail);
+  val seq = nullify(seq_in);
+  val idx = zero;
+
+  for (; seq; seq = cdr(seq), idx = plus(idx, one)) {
+    val elt = car(seq);
+    if (funcall1(func, elt))
+      list_collect(ptail, idx);
+  }
+
+  return out;
+}
+
+val sel(val seq_in, val where_in)
+{
+  list_collect_decl (out, ptail);
+  val seq = nullify(seq_in);
+  val where = nullify(where_in);
+
+  switch (type(seq)) {
+  case NIL:
+    return nil;
+  case CONS:
+  case LCONS:
+    {
+      val idx = zero;
+
+      for (; seq && where; seq = cdr(seq), idx = plus(idx, one)) {
+        val wh;
+
+        do {
+          wh = car(where);
+          where = cdr(where);
+        } while (lt(wh, idx));
+
+        if (eql(wh, idx))
+          list_collect (ptail, car(seq));
+      }
+    }
+    break;
+  default:
+    {
+      val len = length(seq);
+      for (; where; where = cdr(where)) {
+        val wh = car(where);
+        if (ge(wh, len))
+          break;
+        list_collect (ptail, ref(seq, car(where)));
+      }
+    }
+    break;
+  }
+  return make_like(out, seq_in);
+}
+
 val env(void)
 {
   if (env_list) {
diff --git a/lib.h b/lib.h
index 2afe2f16..31ca1413 100644
--- a/lib.h
+++ b/lib.h
@@ -751,6 +751,8 @@ val refset(val seq, val ind, val newval);
 val replace(val seq, val items, val from, val to);
 val update(val seq, val fun);
 val search(val seq, val key, val from, val to);
+val where(val seq, val func);
+val sel(val seq, val where);
 val env(void);
 val obj_print(val obj, val stream);
 val obj_pprint(val obj, val stream);
diff --git a/txr.1 b/txr.1
index 12611670..5bd5e15a 100644
--- a/txr.1
+++ b/txr.1
@@ -5530,9 +5530,18 @@ Example 2:
 
   (call '(1 2 3 4) 1..3) -> (2 3)
 
-Here, the shorthand 1 .. 3 denotes (cons 1 3). This is treated just like
-(call '(1 2 3 4) 1 3), which performs range extraction: taking a slice
-of the list starting at index 1, up to and not including index 3.
+Here, the shorthand 1 .. 3 denotes (cons 1 3). A cons cell as an argument
+to a sequence performs range extraction: taking a slice starting at
+index 1, up to and not including index 3, as if by the call
+(sub '(1 2 3 4) 1 3).
+
+.TP
+Example 3:
+
+  (call '(1 2 3 4) '(0 2)) -> (1 2)
+
+A list of indices applied to a sequence is equivalent to using the
+select function, as if (select '(1 2 3 4) '(0 2)) were called.
 
 .SS Special Variables
 
@@ -6081,6 +6090,12 @@ The range of elements is specified in the car and cdr fields of a cons cell,
 for which the .. (dotdot) syntactic sugar is useful.
 See the section on Indexing below.
 
+.IP [<sequence> <index-list>]
+This is equivalent to (select <sequence> <index-list>). Elements specified
+by <index-list> are extracted from <sequence> and returned as a sequence
+of the same kind as <sequence>. See the description of the sequence function
+for the exact semantics.
+
 .IP "[<hash-table> <key> <default-value>]"
 Retrieve a value from the hash table corresponding to <key>,
 or <default-value> if there is no such entry.
@@ -7721,6 +7736,47 @@ by applying the key function to successive elements. The position of
 the first element for which the predicate function yields true is returned. If
 no such element is found, nil is returned.
 
+.SS Function where
+
+.TP
+Syntax:
+
+  (where <sequence> <function>)
+
+.TP
+Description:
+
+The where function searches <sequence> for elements which satisfy <function>,
+and returns a list of the numeric indices of those elements within
+<sequence>, in order of increasing index.
+
+<function> must be a function that can be called with one argument.
+For each element of <sequence>, <function> is called with that element
+as an argument.  If a non-nil value is returned, then the zero-based index of
+that element is added to a list. Finally, the list is returned.
+
+.SS Function select
+
+.TP
+Syntax:
+
+  (select <sequence> <index-list>)
+
+.TP
+Description:
+
+The select function returns a sequence, of the same kind as <sequence>,
+which consists of those elements of sequence which are identified by
+the numeric indices in <index-list>.
+
+The select function stops processing <sequence> upon encountering
+an index inside <index-list> which is out of range.
+
+If <sequence> is a list, then <index-list> must contain montonically increasing
+numeric values, even if no value is out of range, since the <select> function
+makes a single pass through the list based on the assumption that indices
+are ordered.
+
 .SS Function tree-find
 
 .TP