New rmismatch function.

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

* lib.c (rmismatch): New function.

* lib.h (rmismatch): Declared.

* txr.1: Documented

4 files changed, 132 insertions, 0 deletions

diff --git a/eval.c b/eval.c
index f5895520..3ca3a52c 100644
--- a/eval.c
+++ b/eval.c
@@ -5753,6 +5753,7 @@ void eval_init(void)
   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("mismatch"), user_package), func_n4o(mismatch, 2));
+  reg_fun(intern(lit("rmismatch"), user_package), func_n4o(rmismatch, 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 99e7da76..fad9e198 100644
--- a/lib.c
+++ b/lib.c
@@ -8465,6 +8465,106 @@ val mismatch(val left, val right, val testfun_in, val keyfun_in)
             left, right, nao);
 }
 
+val rmismatch(val left, val right, val testfun_in, val keyfun_in)
+{
+  val testfun = default_arg(testfun_in, equal_f);
+  val keyfun = default_arg(keyfun_in, identity_f);
+
+  switch (type(left)) {
+  case NIL:
+    switch (type(right)) {
+    case NIL:
+      return nil;
+    case CONS:
+    case LCONS:
+      return negone;
+    case VEC:
+    case LIT:
+    case STR:
+      return if3(length(right) == zero, nil, negone);
+    case LSTR:
+      return if3(length_str_lt(right, one), nil, negone);
+    default:
+      break;
+    }
+    break;
+  case CONS:
+  case LCONS:
+  default:
+    switch (type(right)) {
+    case NIL:
+      return negone;
+    case CONS:
+    case LCONS:
+      {
+        val mm = mismatch(reverse(left), reverse(right), testfun, keyfun);
+        return if2(mm, minus(negone, mm));
+      }
+    case VEC:
+    case LIT:
+    case STR:
+    case LSTR:
+      {
+        val rleft = reverse(left);
+        val rlen = length(right);
+        val rpos = pred(rlen);
+
+        for (; !endp(rleft) && !minusp(rpos);
+             rleft = cdr(rleft), rpos = pred(rpos))
+        {
+          val lelt = funcall1(keyfun, car(rleft));
+          val relt = funcall1(keyfun, ref(right, rpos));
+          if (!funcall2(testfun, lelt, relt))
+            break;
+        }
+
+        return if2(rleft || !minusp(rpos), minus(rpos, rlen));
+      }
+    default:
+      break;
+    }
+    break;
+  case STR:
+  case LSTR:
+  case LIT:
+  case VEC:
+    switch (type(right)) {
+    case NIL:
+      return if3(length(left) == zero, nil, zero);
+    case CONS:
+    case LCONS:
+      return rmismatch(right, left, testfun, keyfun);
+    case VEC:
+    case LIT:
+    case STR:
+    case LSTR:
+      {
+        val llen = length(left);
+        val rlen = length(right);
+        val lpos = pred(llen);
+        val rpos = pred(rlen);
+
+        for (; !minusp(lpos) && !minusp(rpos);
+             lpos = pred(lpos), rpos = pred(rpos))
+        {
+          val lelt = funcall1(keyfun, ref(left, lpos));
+          val relt = funcall1(keyfun, ref(right, rpos));
+          if (!funcall2(testfun, lelt, relt))
+            break;
+        }
+
+        return if2(!minusp(lpos) || !minusp(rpos), minus(lpos, llen));
+      }
+    default:
+      break;
+    }
+    break;
+  }
+
+  uw_throwf(error_s, lit("rmismatch: invalid arguments ~!~s and ~s"),
+            left, right, nao);
+}
+
 static val take_list_fun(val env, val lcons)
 {
   cons_bind (list, count, env);
diff --git a/lib.h b/lib.h
index 9e64ba89..79a1fbe9 100644
--- a/lib.h
+++ b/lib.h
@@ -973,6 +973,7 @@ val rpos_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 mismatch(val left, val right, val testfun, val keyfun);
+val rmismatch(val left, val right, 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 c6915a8f..2f4f5452 100644
--- a/txr.1
+++ b/txr.1
@@ -25648,6 +25648,36 @@ 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 @ rmismatch
+.synb
+.mets (rmismatch < left-seq < right-seq >> [ testfun <> [ keyfun ]])
+.syne
+.desc
+Similarly to
+.codn mismatch ,
+the
+.code rmismatch
+function compares corresponding elements from the sequences
+.meta left-seq
+and
+.metn right-seq ,
+returning the position at which the first mismatch occurs.
+All of the arguments have the same semantics as that of
+.codn mismatch .
+
+Unlike
+.codn mismatch ,
+.code rmismatch
+compares the sequences right-to-left, finding the suffix
+which they have in common, rather than prefix.
+
+If the sequences match, then
+.code nil
+is returned. Otherwise, a negative index is returned giving the
+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 Function @ select
 .synb
 .mets (select < object >> { index-list <> | function })