From 1777ba3dc87c62cf18cd178f2055369979907dc8 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 3 Sep 2019 23:29:24 -0700
Subject: New function: tailp.

* eval.c (eval_init): Register tailp intrinsic.

* lib.c (tailp): New function.

* lib.h (tailp): Declared.

* txr.1: Documented.
---
 eval.c |  1 +
 lib.c  | 10 ++++++++++
 lib.h  |  1 +
 txr.1  | 53 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 65 insertions(+)

diff --git a/eval.c b/eval.c
index ef57289f..0058b961 100644
--- a/eval.c
+++ b/eval.c
@@ -6458,6 +6458,7 @@ void eval_init(void)
   reg_fun(intern(lit("split"), user_package), func_n2(split));
   reg_fun(intern(lit("split*"), user_package), func_n2(split_star));
   reg_fun(intern(lit("partition*"), user_package), func_n2(partition_star));
+  reg_fun(intern(lit("tailp"), user_package), func_n2(tailp));
   reg_fun(memq_s, func_n2(memq));
   reg_fun(memql_s, func_n2(memql));
   reg_fun(memqual_s, func_n2(memqual));
diff --git a/lib.c b/lib.c
index 374b038a..ebcd1670 100644
--- a/lib.c
+++ b/lib.c
@@ -1682,6 +1682,16 @@ val ldiff_old(val list1, val list2)
   return make_like(out, list_orig);
 }
 
+val tailp(val obj, val list)
+{
+  while (obj != list) {
+    if (atom(list))
+      return nil;
+    list = cdr(list);
+  }
+  return t;
+}
+
 val memq(val obj, val list)
 {
   val list_orig = list;
diff --git a/lib.h b/lib.h
index a3e0fe82..403a18de 100644
--- a/lib.h
+++ b/lib.h
@@ -613,6 +613,7 @@ val partition(val seq, val indices);
 val split(val seq, val indices);
 val partition_star(val seq, val indices);
 val split_star(val seq, val indices);
+val tailp(val obj, val list);
 val memq(val obj, val list);
 val rmemq(val obj, val list);
 val memql(val obj, val list);
diff --git a/txr.1 b/txr.1
index 003fa4a3..6bb2fc08 100644
--- a/txr.1
+++ b/txr.1
@@ -19568,6 +19568,59 @@ is only a function, not an accessor;
 .code nthcdr
 forms do not denote places.
 
+.coNP Function @ tailp
+.synb
+.mets (tailp < object << list)
+.syne
+.desc
+The
+.code tailp
+function tests whether
+.meta object
+is a tail of
+.metn list .
+This means that
+.meta object
+is either
+.meta list
+itself, or else one of the
+.code cons
+cells of
+.meta list
+or else the terminating atom of
+.metn list .
+
+More formally, a recursive definition follows.
+If
+.meta object
+and
+.meta list
+are the same object (thus equal under the
+.code eq
+function) then
+.code tailp
+returns
+.codn t .
+If
+.meta list
+is an atom, and is not
+.metn object ,
+then the function returns
+.codn nil .
+Otherwise,
+.meta list
+is a
+.code cons
+that is not
+.meta object
+and
+.code tailp
+yields the same value as the
+.mono
+.meti "(tailp < object (cdr << list ))"
+.onom
+expression.
+
 .coNP Accessors @, caar @, cadr @, cdar @, cddr @ ... and @ cdddddr
 .synb
 .mets (caar << object )
-- 
cgit v1.2.3