New functions starts-with and ends-with.

* eval.c (eval_init): Register starts-with and ends-with
intrinsics.

* lib.c (starts_with, ends_with): New functions.

* lib.c (starts_with, ends_with): Declared.

* txr.1: Documented.

4 files changed, 63 insertions, 0 deletions

diff --git a/eval.c b/eval.c
index 3ca3a52c..b4beaa9a 100644
--- a/eval.c
+++ b/eval.c
@@ -5754,6 +5754,8 @@ void eval_init(void)
   reg_fun(intern(lit("pos-min"), user_package), func_n3o(pos_min, 1));
   reg_fun(intern(lit("mismatch"), user_package), func_n4o(mismatch, 2));
   reg_fun(intern(lit("rmismatch"), user_package), func_n4o(rmismatch, 2));
+  reg_fun(intern(lit("starts-with"), user_package), func_n4o(starts_with, 2));
+  reg_fun(intern(lit("ends-with"), user_package), func_n4o(ends_with, 2));
   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));
diff --git a/lib.c b/lib.c
index fad9e198..cd470b8e 100644
--- a/lib.c
+++ b/lib.c
@@ -8565,6 +8565,18 @@ val rmismatch(val left, val right, val testfun_in, val keyfun_in)
             left, right, nao);
 }
 
+val starts_with(val little, val big, val testfun, val keyfun)
+{
+  val mm = mismatch(little, big, testfun, keyfun);
+  return tnil(!mm || eql(mm, length(little)));
+}
+
+val ends_with(val little, val big, val testfun, val keyfun)
+{
+  val mm = rmismatch(little, big, testfun, keyfun);
+  return tnil(!mm || eql(pred(neg(mm)), length(little)));
+}
+
 static val take_list_fun(val env, val lcons)
 {
   cons_bind (list, count, env);
diff --git a/lib.h b/lib.h
index 79a1fbe9..df401e58 100644
--- a/lib.h
+++ b/lib.h
@@ -974,6 +974,8 @@ val pos_max(val seq, val testfun, val keyfun);
 val pos_min(val seq, val testfun, val keyfun);
 val mismatch(val left, val right, val testfun, val keyfun);
 val rmismatch(val left, val right, val testfun, val keyfun);
+val starts_with(val little, val big, val testfun, val keyfun);
+val ends_with(val little, val big, 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);
diff --git a/txr.1 b/txr.1
index 2f4f5452..d9ef1e36 100644
--- a/txr.1
+++ b/txr.1
@@ -25678,6 +25678,53 @@ mismatching position, regarded from the end. If the sequences
 match only in the rightmost element, then -1 is returned. If they
 match in two elements then -2 and so forth.
 
+.coNP Functions @ starts-with and @ ends-with
+.synb
+.mets (starts-with < short-seq < long-seq >> [ testfun <> [ keyfun ]])
+.mets (ends-with < short-seq < long-seq >> [ testfun <> [ keyfun ]])
+.syne
+.desc
+The
+.code starts-with
+and
+.code ends-with
+functions compare corresponding elements from sequences
+.meta short-seq
+and
+.metn long-seq .
+
+The
+.code starts-with
+function returns
+.code t
+if
+.meta short-seq
+is prefix of
+.metn long-seq ;
+otherwise, it returns
+.codn nil .
+
+The
+.code ends-with
+function returns
+.code t
+if
+.meta short-seq
+is suffix of
+.metn long-seq ;
+otherwise, it returns
+.codn nil .
+
+Element from both sequences are mapped to comparison keys using
+.metn keyfun ,
+which defaults to
+.codn identity .
+
+Comparison keys are compared using
+.meta testfun
+which defaults to
+.codn equal .
+
 .coNP Function @ select
 .synb
 .mets (select < object >> { index-list <> | function })