Adding mismatch function.

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

* lib.c (mismatch): New function.

* lib.c (mismatch): Declared.

* txr.1: Documented mismatch.

4 files changed, 155 insertions, 0 deletions

diff --git a/eval.c b/eval.c
index e9c770ef..0f0b516a 100644
--- a/eval.c
+++ b/eval.c
@@ -5311,6 +5311,7 @@ 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("mismatch"), user_package), func_n4o(mismatch, 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 402f41ce..574055b6 100644
--- a/lib.c
+++ b/lib.c
@@ -8286,6 +8286,118 @@ val pos_min(val seq, val testfun, val keyfun)
   return pos_max(seq, default_arg(testfun, less_f), keyfun);
 }
 
+val mismatch(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 zero;
+    case VEC:
+    case LIT:
+    case STR:
+      return if3(length(right) == zero, nil, zero);
+    case LSTR:
+      return if3(length_str_lt(right, one), nil, zero);
+    default:
+      break;
+    }
+    break;
+  case CONS:
+  case LCONS:
+  default:
+    switch (type(right)) {
+    case NIL:
+      return zero;
+    case CONS:
+    case LCONS:
+      {
+        val pos = zero;
+
+        gc_hint(left);
+        gc_hint(right);
+
+        for (; !endp(left) && !endp(right);
+             left = cdr(left), right = cdr(right), pos = succ(pos))
+        {
+          val lelt = funcall1(keyfun, car(left));
+          val relt = funcall1(keyfun, car(right));
+          if (!funcall2(testfun, lelt, relt))
+            break;
+        }
+
+        return if3(left || right, pos, nil);
+      }
+    case VEC:
+    case LIT:
+    case STR:
+    case LSTR:
+      {
+        val pos = zero;
+        val rlen = length(right);
+
+        gc_hint(left);
+
+        for (; !endp(left) && lt(pos, rlen);
+             left = cdr(left), pos = succ(pos))
+        {
+          val lelt = funcall1(keyfun, car(left));
+          val relt = funcall1(keyfun, ref(right, pos));
+          if (!funcall2(testfun, lelt, relt))
+            break;
+        }
+
+        return if3(left || lt(pos, rlen), pos, nil);
+      }
+    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 mismatch(right, left, testfun, keyfun);
+    case VEC:
+    case LIT:
+    case STR:
+    case LSTR:
+      {
+        val llen = length(left);
+        val rlen = length(right);
+        val pos = zero;
+
+        for (; lt(pos, llen) && lt(pos, rlen); pos = succ(pos))
+        {
+          val lelt = funcall1(keyfun, ref(left, pos));
+          val relt = funcall1(keyfun, ref(right, pos));
+          if (!funcall2(testfun, lelt, relt))
+            break;
+        }
+
+        return if3(lt(pos, llen) || lt(pos, rlen), pos, nil);
+      }
+    default:
+      break;
+    }
+    break;
+  }
+
+  uw_throwf(error_s, lit("mismatch: 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 3ebc5c22..79af8aad 100644
--- a/lib.h
+++ b/lib.h
@@ -961,6 +961,7 @@ val pos_if(val pred, val list, val key);
 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 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 549a7da3..78f72bf4 100644
--- a/txr.1
+++ b/txr.1
@@ -24729,6 +24729,47 @@ from
 is passed through this one-argument function, and
 the resulting value is used in its place.
 
+.coNP Function @ mismatch
+.synb
+.mets (mismatch < left-seq < right-seq >> [ testfun <> [ keyfun ]])
+.syne
+.desc
+The
+.code mismatch
+function compares corresponding elements from the sequences
+.meta left-seq
+and
+.metn right-seq ,
+returning the position at which the first mismatch occurs.
+
+If the sequences are of the same length, and their corresponding
+elements are the same, then
+.code nil
+is returned.
+
+If one sequence is shorter than the other, and matches a prefix
+of the other, then the mismatching position returned is one position
+after the last element of the shorter sequence, the same value
+as its length. An empty sequence is a prefix of every sequence.
+
+The
+.meta keyfun
+argument defaults to the
+.code identity
+function. Each element
+from
+.meta sequence
+is passed to
+.meta keyfun
+and the resulting value is used in its place.
+
+After being converted through
+.metn keyfun ,
+items are then compared using
+.metn testfun ,
+which must accept two arguments, and defaults to
+.codn equal .
+
 .coNP Function @ where
 .synb
 .mets (where < function << object )