New functions take, drop, {take,drop}-{while,until}.

* lib.c (take_list_fun, take_while_list_fun,
take_until_list_fun): New static functions.
(take, take_while, take_until, drop, drop_while,
drop_until): New functions.

* eval.c (eval_init): Register intrinsics take,
take-while, take-until, drop, drop-while, drop-until.

* txr.1: Documented.

4 files changed, 380 insertions, 0 deletions

diff --git a/eval.c b/eval.c
index 74127bf9..f9a51fed 100644
--- a/eval.c
+++ b/eval.c
@@ -4323,6 +4323,12 @@ void eval_init(void)
   reg_fun(intern(lit("clamp"), user_package), func_n3(clamp));
   reg_fun(intern(lit("pos-max"), user_package), func_n3o(pos_max, 1));
   reg_fun(intern(lit("pos-min"), user_package), func_n3o(pos_min, 1));
+  reg_fun(intern(lit("take"), user_package), func_n2(take));
+  reg_fun(intern(lit("take-while"), user_package), func_n3o(take_while, 2));
+  reg_fun(intern(lit("take-until"), user_package), func_n3o(take_until, 2));
+  reg_fun(intern(lit("drop"), user_package), func_n2(drop));
+  reg_fun(intern(lit("drop-while"), user_package), func_n3o(drop_while, 2));
+  reg_fun(intern(lit("drop-until"), user_package), func_n3o(drop_until, 2));
   reg_fun(intern(lit("in"), user_package), func_n4o(in, 2));
   reg_fun(intern(lit("logand"), user_package), func_n0v(logandv));
   reg_fun(intern(lit("logior"), user_package), func_n0v(logiorv));
diff --git a/lib.c b/lib.c
index 87abf0b9..25299bc7 100644
--- a/lib.c
+++ b/lib.c
@@ -6625,6 +6625,193 @@ val pos_min(val seq, val testfun, val keyfun)
   return pos_max(seq, default_arg(testfun, less_f), keyfun);
 }
 
+static val take_list_fun(val env, val lcons)
+{
+  cons_bind (list, count, env);
+
+  rplaca(lcons, pop(&list));
+
+  if3(le((count = pred(count)), zero) || list == nil,
+      rplacd(lcons, nil),
+      rplacd(lcons, make_lazy_cons(lcons_fun(lcons))));
+
+  rplaca(env, list);
+  rplacd(env, count);
+  return nil;
+}
+
+val take(val count, val seq)
+{
+  switch (type(seq)) {
+  case NIL:
+    return nil;
+  case CONS:
+  case LCONS:
+    if (le(count, zero))
+      return nil;
+    return make_lazy_cons(func_f1(cons(seq, count), take_list_fun));
+  case LSTR:
+  case LIT:
+  case STR:
+  case VEC:
+    return sub(seq, zero, count);
+  default:
+    type_mismatch(lit("take: ~s is not a sequence"), seq, nao);
+  }
+}
+
+static val take_while_list_fun(val env, val lcons)
+{
+  cons_bind (list, cell, env);
+  cons_bind (pred, keyfun, cell);
+
+  rplaca(lcons, pop(&list));
+
+  if (!funcall1(pred, funcall1(keyfun, car(list))))
+    rplacd(lcons, nil);
+  else
+    rplacd(lcons, make_lazy_cons(lcons_fun(lcons)));
+
+  rplaca(env, list);
+  return nil;
+}
+
+val take_while(val pred, val seq, val keyfun)
+{
+  switch (type(seq)) {
+  case NIL:
+    return nil;
+  case CONS:
+  case LCONS:
+    keyfun = default_arg(keyfun, identity_f);
+    if (!funcall1(pred, funcall1(keyfun, (car(seq)))))
+      return nil;
+    return make_lazy_cons(func_f1(cons(seq, cons(pred, keyfun)),
+                                  take_while_list_fun));
+  case LSTR:
+  case LIT:
+  case STR:
+  case VEC:
+    {
+      val pos = pos_if(notf(pred), seq, keyfun);
+      if (!pos)
+        return seq;
+      return sub(seq, zero, pos);
+    }
+  default:
+    type_mismatch(lit("take-while: ~s is not a sequence"), seq, nao);
+  }
+}
+
+static val take_until_list_fun(val env, val lcons)
+{
+  cons_bind (list, cell, env);
+  cons_bind (pred, keyfun, cell);
+  val item = pop(&list);
+
+  rplaca(lcons, item);
+
+  if (funcall1(pred, funcall1(keyfun, item)))
+    rplacd(lcons, nil);
+  else
+    rplacd(lcons, make_lazy_cons(lcons_fun(lcons)));
+
+  rplaca(env, list);
+  return nil;
+}
+
+val take_until(val pred, val seq, val keyfun)
+{
+  switch (type(seq)) {
+  case NIL:
+    return nil;
+  case CONS:
+  case LCONS:
+    return make_lazy_cons(func_f1(cons(seq, cons(pred, keyfun)),
+                                  take_until_list_fun));
+  case LSTR:
+  case LIT:
+  case STR:
+  case VEC:
+    {
+      val key = default_arg(keyfun, identity_f);
+      val pos = pos_if(pred, seq, key);
+      if (!pos)
+        return seq;
+      return sub(seq, zero, succ(pos));
+    }
+  default:
+    type_mismatch(lit("take-until: ~s is not a sequence"), seq, nao);
+  }
+}
+
+val drop(val count, val seq)
+{
+  if (le(count, zero))
+    return seq;
+  return sub(seq, count, t);
+}
+
+val drop_while(val pred, val seq, val keyfun)
+{
+  switch (type(seq)) {
+  case NIL:
+    return nil;
+  case CONS:
+  case LCONS:
+    keyfun = default_arg(keyfun, identity_f);
+    while (seq && funcall1(pred, funcall1(keyfun, car(seq))))
+      pop(&seq);
+    return seq;
+  case LSTR:
+  case LIT:
+  case STR:
+  case VEC:
+    {
+      val key = default_arg(keyfun, identity_f);
+      val pos = pos_if(notf(pred), seq, key);
+      if (!pos)
+        return make_like(nil, seq);
+      return sub(seq, pos, t);
+    }
+  default:
+    type_mismatch(lit("drop-while: ~s is not a sequence"), seq, nao);
+  }
+}
+
+val drop_until(val pred, val seq, val keyfun)
+{
+  switch (type(seq)) {
+  case NIL:
+    return nil;
+  case CONS:
+  case LCONS:
+    {
+      val key = default_arg(keyfun, identity_f);
+      val item;
+
+      do {
+        item = pop(&seq);
+      } while (!funcall1(pred, funcall1(key, item)));
+
+      return seq;
+    }
+  case LSTR:
+  case LIT:
+  case STR:
+  case VEC:
+    {
+      val key = default_arg(keyfun, identity_f);
+      val pos = pos_if(pred, seq, key);
+      if (!pos)
+        return seq;
+      return sub(seq, succ(pos), t);
+    }
+  default:
+    type_mismatch(lit("drop-until: ~s is not a sequence"), seq, nao);
+  }
+}
+
 val in(val seq, val item, val testfun, val keyfun)
 {
   switch (type(seq)) {
diff --git a/lib.h b/lib.h
index 41b8608b..e48904a4 100644
--- a/lib.h
+++ b/lib.h
@@ -872,6 +872,12 @@ val pos(val list, val key, val testfun, val keyfun);
 val pos_if(val pred, val list, val key);
 val pos_max(val seq, val testfun, val keyfun);
 val pos_min(val seq, val testfun, val keyfun);
+val take(val count, val seq);
+val take_while(val pred, val seq, val keyfun);
+val take_until(val pred, val seq, val keyfun);
+val drop(val count, val seq);
+val drop_while(val pred, val seq, val keyfun);
+val drop_until(val pred, val seq, val keyfun);
 val in(val seq, val key, val testfun, val keyfun);
 val set_diff(val list1, val list2, val testfun, val keyfun);
 val copy(val seq);
diff --git a/txr.1 b/txr.1
index f8d2dd89..4f496ec3 100644
--- a/txr.1
+++ b/txr.1
@@ -19167,6 +19167,187 @@ is a list, then
 must
 be monotonically increasing.
 
+.coNP Function @ take
+.synb
+.mets (take < count << sequence )
+.syne
+.desc
+The
+.code take
+function returns
+.meta sequence
+with all except the first
+.meta count
+items removed.
+
+If
+.meta sequence
+is a list, then
+.code take
+returns a lazy list which produces the first
+.meta count
+items of sequence.
+
+For other kinds of sequences, including lazy strings,
+.code drop
+works eagerly.
+
+If
+.meta count
+exceeds the length of
+.meta sequence
+then a sequence is returned which has all the items.
+This object may be
+.meta sequence
+itself, or a copy.
+
+If
+.meta count
+is negative, it is treated as zero.
+
+.coNP Functions @ take-while and @ take-until
+.synb
+.mets (take-while < predfun < sequence <> [ keyfun ])
+.mets (take-until < predfun < sequence <> [ keyfun ])
+.syne
+.desc
+The
+.code take-while
+and
+.code take-until
+functions return a prefix of
+.meta sequence
+whose items satisfy certain conditions.
+
+The
+.code take-while
+function returns the longest prefix of
+.meta sequence
+whose elements, accessed through
+.meta keyfun
+satisfy the function
+.metn predfun .
+
+The
+.meta keyfun
+argument defaults to the identity function: the elements
+of
+.meta sequence
+are examined themselves.
+
+The
+.code take-until
+function returns the longest prefix of
+.meta sequence
+which consists of elements, accessed through
+.metn keyfun ,
+that do
+.B not
+satisfy
+.meta predfun
+followed by an element which does satisfy
+.metn predfun .
+If
+.meta sequence
+has no such prefix, then an empty sequence
+is returned of the same kind as
+.metn sequence .
+
+If
+.meta sequence
+is a list, then these functions return a lazy list.
+
+.coNP Function @ drop
+.synb
+.mets (drop < count << sequence )
+.syne
+.desc
+The
+.code drop
+function returns
+.meta sequence
+with the first
+.meta count
+items removed.
+
+If
+.meta count
+is negative, it is treated as zero.
+
+If
+.meta count
+is zero, then
+.meta sequence
+is returned.
+
+If
+.meta count
+exceeds the length of
+.meta sequence
+then an empty sequence is returned
+of the same kind as
+.metn sequence .
+
+.coNP Functions @ drop-while and @ drop-until
+.synb
+.mets (drop-while < predfun < sequence <> [ keyfun ])
+.mets (drop-until < predfun < sequence <> [ keyfun ])
+.syne
+.desc
+The
+.code drop-while
+and
+.code drop-until
+functions return
+.meta sequence
+with a prefix of that sequence removed,
+according to conditions involving
+.meta predfun
+and
+.metn keyfun .
+
+
+The
+.code drop-while
+function removes the longest prefix of
+.meta sequence
+whose elements, accessed through
+.meta keyfun
+satisfy the function
+.metn predfun ,
+and returns the remaining sequence.
+
+The
+.meta keyfun
+argument defaults to the identity function: the elements
+of
+.meta sequence
+are examined themselves.
+
+The
+.code drop-until
+function removes the longest prefix of
+.meta sequence
+which consists of elements, accessed through
+.metn keyfun ,
+that do
+.B not
+satisfy
+.meta predfun
+followed by an element which does satisfy
+.metn predfun .
+A sequence of the remaining elements is
+returned.
+
+If
+.meta sequence
+has no such prefix, then a sequence
+same as
+.meta sequence
+is returned, which may be
+.meta sequence
+itself or a copy.
+
 .coNP Function @ search
 .synb
 .mets (search < haystack < needle >> [ testfun <> [ keyfun ])