xemacs-beta: src/fns.c comparison

comparison src/fns.c @ 5448:89331fa1c819

Merged with trunk.

author	Mats Lidell <matsl@xemacs.org>
date	Thu, 06 Jan 2011 00:35:22 +0100
parents	771bf922ab2b 1dbc93b7ba19
children	a9094f28f9a9

comparison

equal deleted inserted replaced

-:4b08f375e2fb
+:89331fa1c819
 #include "opaque.h"
 /* NOTE: This symbol is also used in lread.c */
 #define FEATUREP_SYNTAX
-Lisp_Object Qstring_lessp, Qsort, Qmerge, Qfill, Qreplace;
+Lisp_Object Qstring_lessp, Qmerge, Qfill, Qreplace, QassocX, QrassocX;
-Lisp_Object Qidentity;
+Lisp_Object Qposition, Qfind, QdeleteX, QremoveX, Qidentity, Qadjoin;
 Lisp_Object Qvector, Qarray, Qbit_vector, QsortX, Q_from_end, Q_initial_value;
 Lisp_Object Qmapconcat, QmapcarX, Qmapvector, Qmapcan, Qmapc, Qmap, Qmap_into;
-Lisp_Object Qsome, Qevery, Qmaplist, Qmapl, Qmapcon, Qreduce;
+Lisp_Object Qsome, Qevery, Qmaplist, Qmapl, Qmapcon, Qreduce, Qsubstitute;
-Lisp_Object Q_start1, Q_start2, Q_end1, Q_end2;
+Lisp_Object Q_start1, Q_start2, Q_end1, Q_end2, Q_if_, Q_if_not, Q_stable;
+Lisp_Object Q_test_not, Q_count, Qnsubstitute, Qdelete_duplicates, Qmismatch;
+Lisp_Object Qintersection, Qset_difference, Qnset_difference;
+Lisp_Object Qnunion, Qnintersection, Qsubsetp;
 Lisp_Object Qbase64_conversion_error;
 Lisp_Object Vpath_separator;
+extern Fixnum max_lisp_eval_depth;
+extern int lisp_eval_depth;
 static int internal_old_equal (Lisp_Object, Lisp_Object, int);
 Lisp_Object safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth);
 static DOESNT_RETURN
 				     bit_vector_equal,
 				     bit_vector_hash,
 				     bit_vector_description,
 				     size_bit_vector,
 				     Lisp_Bit_Vector);
+/* Various test functions for #'member*, #'assoc* and the other functions
+that take both TEST and KEY arguments.  */
+typedef Boolint (*check_test_func_t) (Lisp_Object test, Lisp_Object key,
+				      Lisp_Object item, Lisp_Object elt);
+static Boolint
+check_eq_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
+		Lisp_Object item, Lisp_Object elt)
+{
+return EQ (item, elt);
+}
+static Boolint
+check_eq_key (Lisp_Object UNUSED (test), Lisp_Object key, Lisp_Object item,
+	      Lisp_Object elt)
+{
+elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt));
+return EQ (item, elt);
+}
+/* The next two are not used by #'member* and #'assoc*, since we can decide
+on #'eq vs. #'equal when we have the type of ITEM.  */
+static Boolint
+check_eql_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
+		       Lisp_Object elt1, Lisp_Object elt2)
+{
+return EQ (elt1, elt2)
+|| (NON_FIXNUM_NUMBER_P (elt1) && internal_equal (elt1, elt2, 0));
+}
+static Boolint
+check_eql_key (Lisp_Object UNUSED (test), Lisp_Object key, Lisp_Object item,
+	       Lisp_Object elt)
+{
+elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt));
+return EQ (item, elt)
+|| (NON_FIXNUM_NUMBER_P (item) && internal_equal (item, elt, 0));
+}
+static Boolint
+check_equal_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
+		   Lisp_Object item, Lisp_Object elt)
+{
+return internal_equal (item, elt, 0);
+}
+static Boolint
+check_equal_key (Lisp_Object UNUSED (test), Lisp_Object key, Lisp_Object item,
+		 Lisp_Object elt)
+{
+elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt));
+return internal_equal (item, elt, 0);
+}
+static Boolint
+check_equalp_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
+		   Lisp_Object item, Lisp_Object elt)
+{
+return internal_equalp (item, elt, 0);
+}
+static Boolint
+check_equalp_key (Lisp_Object UNUSED (test), Lisp_Object key,
+		  Lisp_Object item, Lisp_Object elt)
+{
+elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt));
+return internal_equalp (item, elt, 0);
+}
+static Boolint
+check_string_match_nokey (Lisp_Object UNUSED (test), Lisp_Object UNUSED (key),
+			  Lisp_Object item, Lisp_Object elt)
+{
+return !NILP (Fstring_match (item, elt, Qnil, Qnil));
+}
+static Boolint
+check_string_match_key (Lisp_Object UNUSED (test), Lisp_Object key,
+			Lisp_Object item, Lisp_Object elt)
+{
+elt = IGNORE_MULTIPLE_VALUES (call1 (key, elt));
+return !NILP (Fstring_match (item, elt, Qnil, Qnil));
+}
+static Boolint
+check_other_nokey (Lisp_Object test, Lisp_Object UNUSED (key),
+		   Lisp_Object item, Lisp_Object elt)
+{
+Lisp_Object args[] = { test, item, elt };
+struct gcpro gcpro1;
+GCPRO1 (args[0]);
+gcpro1.nvars = countof (args);
+item = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args));
+UNGCPRO;
+return !NILP (item);
+}
+static Boolint
+check_other_key (Lisp_Object test, Lisp_Object key,
+		 Lisp_Object item, Lisp_Object elt)
+{
+Lisp_Object args[] = { item, key, elt };
+struct gcpro gcpro1;
+GCPRO1 (args[0]);
+gcpro1.nvars = countof (args);
+args[2] = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args) - 1, args + 1));
+args[1] = item;
+args[0] = test;
+item = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args));
+UNGCPRO;
+return !NILP (item);
+}
+static Boolint
+check_if_nokey (Lisp_Object test, Lisp_Object UNUSED (key),
+		Lisp_Object UNUSED (item), Lisp_Object elt)
+{
+elt = IGNORE_MULTIPLE_VALUES (call1 (test, elt));
+return !NILP (elt);
+}
+static Boolint
+check_if_key (Lisp_Object test, Lisp_Object key,
+	      Lisp_Object UNUSED (item), Lisp_Object elt)
+{
+Lisp_Object args[] = { key, elt };
+struct gcpro gcpro1;
+GCPRO1 (args[0]);
+gcpro1.nvars = countof (args);
+args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args));
+args[0] = test;
+elt = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args));
+UNGCPRO;
+return !NILP (elt);
+}
+static Boolint
+check_match_eq_key (Lisp_Object UNUSED (test), Lisp_Object key,
+		    Lisp_Object elt1, Lisp_Object elt2)
+{
+Lisp_Object args[] = { key, elt1, elt2 };
+struct gcpro gcpro1;
+GCPRO1 (args[0]);
+gcpro1.nvars = countof (args);
+args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
+args[1] = key;
+args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
+UNGCPRO;
+return EQ (args[0], args[1]);
+}
+static Boolint
+check_match_eql_key (Lisp_Object UNUSED (test), Lisp_Object key,
+		       Lisp_Object elt1, Lisp_Object elt2)
+{
+Lisp_Object args[] = { key, elt1, elt2 };
+struct gcpro gcpro1;
+GCPRO1 (args[0]);
+gcpro1.nvars = countof (args);
+args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
+args[1] = key;
+args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
+UNGCPRO;
+return EQ (args[0], args[1]) ||
+(NON_FIXNUM_NUMBER_P (args[0]) && internal_equal (args[0], args[1], 0));
+}
+static Boolint
+check_match_equal_key (Lisp_Object UNUSED (test), Lisp_Object key,
+		       Lisp_Object elt1, Lisp_Object elt2)
+{
+Lisp_Object args[] = { key, elt1, elt2 };
+struct gcpro gcpro1;
+GCPRO1 (args[0]);
+gcpro1.nvars = countof (args);
+args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
+args[1] = key;
+args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
+UNGCPRO;
+return internal_equal (args[0], args[1], 0);
+}
+static Boolint
+check_match_equalp_key (Lisp_Object UNUSED (test), Lisp_Object key,
+			Lisp_Object elt1, Lisp_Object elt2)
+{
+Lisp_Object args[] = { key, elt1, elt2 };
+struct gcpro gcpro1;
+GCPRO1 (args[0]);
+gcpro1.nvars = countof (args);
+args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
+args[1] = key;
+args[1] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
+UNGCPRO;
+return internal_equalp (args[0], args[1], 0);
+}
+static Boolint
+check_match_other_key (Lisp_Object test, Lisp_Object key,
+		       Lisp_Object elt1, Lisp_Object elt2)
+{
+Lisp_Object args[] = { key, elt1, elt2 };
+struct gcpro gcpro1;
+GCPRO1 (args[0]);
+gcpro1.nvars = countof (args);
+args[0] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args));
+args[1] = key;
+args[2] = IGNORE_MULTIPLE_VALUES (Ffuncall (2, args + 1));
+args[1] = args[0];
+args[0] = test;
+elt1 = IGNORE_MULTIPLE_VALUES (Ffuncall (countof (args), args));
+UNGCPRO;
+return !NILP (elt1);
+}
+static check_test_func_t
+get_check_match_function_1 (Lisp_Object item,
+			    Lisp_Object *test_inout, Lisp_Object test_not,
+			    Lisp_Object if_, Lisp_Object if_not,
+			    Lisp_Object key, Boolint *test_not_unboundp_out,
+			    check_test_func_t *test_func_out)
+{
+Lisp_Object test = *test_inout;
+check_test_func_t result = NULL, test_func = NULL;
+Boolint force_if = 0;
+if (!NILP (if_))
+{
+if (!(NILP (test) && NILP (test_not) && NILP (if_not)))
+	{
+	  invalid_argument ("only one keyword among :test :test-not "
+			    ":if :if-not allowed", if_);
+	}
+test = *test_inout = if_;
+force_if = 1;
+}
+else if (!NILP (if_not))
+{
+if (!(NILP (test) && NILP (test_not)))
+	{
+	  invalid_argument ("only one keyword among :test :test-not "
+			    ":if :if-not allowed", if_not);
+	}
+test_not = if_not;
+force_if = 1;
+}
+if (NILP (test))
+{
+if (!NILP (test_not))
+	{
+	  test = *test_inout = test_not;
+	  if (NULL != test_not_unboundp_out)
+	    {
+	      *test_not_unboundp_out = 0;
+	    }
+	}
+else
+	{
+	  test = Qeql;
+	  if (NULL != test_not_unboundp_out)
+	    {
+	      *test_not_unboundp_out = 1;
+	    }
+	}
+}
+else if (!NILP (test_not))
+{
+invalid_argument_2 ("conflicting :test and :test-not keyword arguments",
+			  test, test_not);
+}
+test = indirect_function (test, 1);
+if (NILP (key) ||
+EQ (indirect_function (key, 1), XSYMBOL_FUNCTION (Qidentity)))
+{
+key = Qidentity;
+}
+if (force_if)
+{
+result = EQ (key, Qidentity) ? check_if_nokey : check_if_key;
+if (NULL != test_func_out)
+	{
+	  *test_func_out = result;
+	}
+return result;
+}
+if (!UNBOUNDP (item) && EQ (test, XSYMBOL_FUNCTION (Qeql)))
+{
+test = XSYMBOL_FUNCTION (NON_FIXNUM_NUMBER_P (item) ? Qequal : Qeq);
+}
+#define FROB(known_test, eq_condition)				\
+if (EQ (test, XSYMBOL_FUNCTION (Q##known_test))) do		\
+{								\
+if (eq_condition)						\
+	{							\
+	  test = XSYMBOL_FUNCTION (Qeq);			\
+	  goto force_eq_check;					\
+	}							\
+								\
+if (!EQ (Qidentity, key))					\
+	{							\
+	  test_func = check_##known_test##_key;			\
+	  result = check_match_##known_test##_key;		\
+	}							\
+else							\
+	{							\
+	  result = test_func = check_##known_test##_nokey;	\
+	}							\
+} while (0)
+FROB (eql, 0);
+else if (SUBRP (test))
+{
+force_eq_check:
+FROB (eq, 0);
+else FROB (equal, (SYMBOLP (item) || INTP (item) || CHARP (item)));
+else FROB (equalp, (SYMBOLP (item)));
+else if (EQ (test, XSYMBOL_FUNCTION (Qstring_match)))
+	{
+	  if (EQ (Qidentity, key))
+	    {
+	      test_func = result = check_string_match_nokey;
+	    }
+	  else
+	    {
+	      test_func = check_string_match_key;
+	      result = check_other_key;
+	    }
+	}
+}
+if (NULL == result)
+{
+if (EQ (Qidentity, key))
+	{
+	  test_func = result = check_other_nokey;
+	}
+else
+	{
+	  test_func = check_other_key;
+	  result = check_match_other_key;
+	}
+}
+if (NULL != test_func_out)
+{
+*test_func_out = test_func;
+}
+return result;
+}
+#undef FROB
+/* Given TEST, TEST_NOT, IF, IF_NOT, KEY, and ITEM, return a C function
+pointer appropriate for use in deciding whether a given element of a
+sequence satisfies TEST.
+Set *test_not_unboundp_out to 1 if TEST_NOT was not bound; set it to zero
+if it was bound, and set *test_inout to the value it was bound to. If
+TEST was not bound, leave *test_inout alone; the value is not used by
+check_eq_*key() or check_equal_*key(), which are the defaults, depending
+on the type of ITEM.
+The returned function takes arguments (TEST, KEY, ITEM, ELT), where ITEM
+is the item being searched for and ELT is the element of the sequence
+being examined.
+Error if both TEST and TEST_NOT were specified, which Common Lisp says is
+undefined behaviour. */
+static check_test_func_t
+get_check_test_function (Lisp_Object item,
+			 Lisp_Object *test_inout, Lisp_Object test_not,
+			 Lisp_Object if_, Lisp_Object if_not,
+			 Lisp_Object key, Boolint *test_not_unboundp_out)
+{
+check_test_func_t result = NULL;
+get_check_match_function_1 (item, test_inout, test_not, if_, if_not,
+			      key, test_not_unboundp_out, &result);
+return result;
+}
+/* Given TEST, TEST_NOT, IF, IF_NOT and KEY, return a C function pointer
+appropriate for use in deciding whether two given elements of a sequence
+satisfy TEST.
+Set *test_not_unboundp_out to 1 if TEST_NOT was not bound; set it to zero
+if it was bound, and set *test_inout to the value it was bound to. If
+TEST was not bound, leave *test_inout alone; the value is not used by
+check_eql_*key().
+The returned function takes arguments (TEST, KEY, ELT1, ELT2), where ELT1
+and ELT2 are elements of the sequence being examined.
+The value that would be given by get_check_test_function() is returned in
+*TEST_FUNC_OUT, which allows calling functions to do their own key checks
+if they're processing one element at a time.
+Error if both TEST and TEST_NOT were specified, which Common Lisp says is
+undefined behaviour. */
+static check_test_func_t
+get_check_match_function (Lisp_Object *test_inout, Lisp_Object test_not,
+			  Lisp_Object if_, Lisp_Object if_not,
+			  Lisp_Object key, Boolint *test_not_unboundp_out,
+			  check_test_func_t *test_func_out)
+{
+return get_check_match_function_1 (Qunbound, test_inout, test_not,
+				     if_, if_not, key,
+				     test_not_unboundp_out, test_func_out);
+}
 DEFUN ("identity", Fidentity, 1, 1, 0, /*
 Return the argument unchanged.
 */
 signal_malformed_list_error (list);
 }
 return EQ (hare, tortoise) && len != 0 ? Qnil : make_int (len);
 }
+static Lisp_Object string_count_from_end (Lisp_Object, Lisp_Object ,
+check_test_func_t, Boolint,
+Lisp_Object, Lisp_Object,
+Lisp_Object, Lisp_Object);
+static Lisp_Object list_count_from_end (Lisp_Object, Lisp_Object,
+check_test_func_t, Boolint,
+Lisp_Object, Lisp_Object,
+Lisp_Object, Lisp_Object);
+/* Count the number of occurrences of ITEM in SEQUENCE; if SEQUENCE is a
+list, store the cons cell of which the car is the last ITEM in SEQUENCE,
+at the address given by tail_out. */
+static Lisp_Object
+count_with_tail (Lisp_Object *tail_out, int nargs, Lisp_Object *args,
+		 Lisp_Object caller)
+{
+Lisp_Object item = args[0], sequence = args[1];
+Elemcount starting = 0, ending = EMACS_INT_MAX, encountered = 0;
+Elemcount len, ii = 0, counting = EMACS_INT_MAX;
+Boolint test_not_unboundp = 1;
+check_test_func_t check_test = NULL;
+PARSE_KEYWORDS_8 (caller, nargs, args, 9,
+		    (test, key, start, end, from_end, test_not, count,
+		     if_, if_not), (start = Qzero), 2, 0);
+CHECK_SEQUENCE (sequence);
+CHECK_NATNUM (start);
+starting = BIGNUMP (start) ? 1 + EMACS_INT_MAX : XINT (start);
+if (!NILP (end))
+{
+CHECK_NATNUM (end);
+ending = BIGNUMP (end) ? 1 + EMACS_INT_MAX : XINT (end);
+}
+if (!NILP (count))
+{
+CHECK_INTEGER (count);
+counting = BIGNUMP (count) ? EMACS_INT_MAX + 1 : XINT (count);
+/* Our callers should have filtered out non-positive COUNT. */
+assert (counting >= 0);
+/* And we're not prepared to handle COUNT from any other caller at the
+	 moment. */
+assert (EQ (caller, QremoveX));
+}
+check_test = get_check_test_function (item, &test, test_not, if_, if_not,
+					key, &test_not_unboundp);
+*tail_out = Qnil;
+if (CONSP (sequence))
+{
+Lisp_Object elt, tail = Qnil;
+struct gcpro gcpro1;
+if (EQ (caller, Qcount) && !NILP (from_end)
+&& (!EQ (key, Qnil) ||
+check_test == check_other_nokey || check_test == check_if_nokey))
+{
+/* #'count, #'count-if, and #'count-if-not are documented to have
+a given traversal order if :from-end t is passed in, even
+though forward traversal of the sequence has the same result
+and is algorithmically less expensive for lists and strings.
+This order isn't necessary for other callers, though. */
+return list_count_from_end (item, sequence, check_test,
+test_not_unboundp, test, key,
+start, end);
+}
+GCPRO1 (tail);
+/* If COUNT is non-nil and FROM-END is t, we can give the tail
+containing the last match, since that's what #'remove* is
+interested in (a zero or negative COUNT won't ever reach
+count_with_tail(), our callers will return immediately on seeing
+it). */
+if (!NILP (count) && !NILP (from_end))
+{
+counting = EMACS_INT_MAX;
+}
+{
+EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tail, len)
+{
+if (!(ii < ending))
+{
+break;
+}
+if (starting <= ii &&
+check_test (test, key, item, elt) == test_not_unboundp)
+{
+encountered++;
+*tail_out = tail;
+if (encountered == counting)
+{
+break;
+}
+}
+ii++;
+}
+}
+UNGCPRO;
+if ((ii < starting || (ii < ending && !NILP (end))) &&
+encountered != counting)
+{
+check_sequence_range (args[1], start, end, Flength (args[1]));
+}
+}
+else if (STRINGP (sequence))
+{
+Ibyte *startp = XSTRING_DATA (sequence), *cursor = startp;
+Bytecount byte_len = XSTRING_LENGTH (sequence), cursor_offset = 0;
+Lisp_Object character = Qnil;
+if (EQ (caller, Qcount) && !NILP (from_end)
+&& (!EQ (key, Qnil) ||
+check_test == check_other_nokey || check_test == check_if_nokey))
+{
+/* See comment above in the list code. */
+return string_count_from_end (item, sequence,
+check_test, test_not_unboundp,
+test, key, start, end);
+}
+while (cursor_offset < byte_len && ii < ending && encountered < counting)
+{
+if (ii >= starting)
+{
+character = make_char (itext_ichar (cursor));
+if (check_test (test, key, item, character)
+== test_not_unboundp)
+{
+encountered++;
+}
+startp = XSTRING_DATA (sequence);
+cursor = startp + cursor_offset;
+if (byte_len != XSTRING_LENGTH (sequence)
+|| !valid_ibyteptr_p (cursor))
+{
+mapping_interaction_error (caller, sequence);
+}
+}
+INC_IBYTEPTR (cursor);
+cursor_offset = cursor - startp;
+ii++;
+}
+if (ii < starting || (ii < ending && !NILP (end)))
+{
+check_sequence_range (sequence, start, end, Flength (sequence));
+}
+}
+else
+{
+Lisp_Object object = Qnil;
+len = XINT (Flength (sequence));
+check_sequence_range (sequence, start, end, make_int (len));
+ending = min (ending, len);
+if (0 == len)
+	{
+	  /* Catches the case where we have nil.  */
+	  return make_integer (encountered);
+	}
+if (NILP (from_end))
+	{
+	  for (ii = starting; ii < ending && encountered < counting; ii++)
+	    {
+	      object = Faref (sequence, make_int (ii));
+	      if (check_test (test, key, item, object) == test_not_unboundp)
+		{
+		  encountered++;
+		}
+	    }
+	}
+else
+	{
+	  for (ii = ending - 1; ii >= starting && encountered < counting; ii--)
+	    {
+	      object = Faref (sequence, make_int (ii));
+	      if (check_test (test, key, item, object) == test_not_unboundp)
+		{
+		  encountered++;
+		}
+	    }
+	}
+}
+return make_integer (encountered);
+}
+static Lisp_Object
+list_count_from_end (Lisp_Object item, Lisp_Object sequence,
+check_test_func_t check_test, Boolint test_not_unboundp,
+Lisp_Object test, Lisp_Object key,
+Lisp_Object start, Lisp_Object end)
+{
+Elemcount length = XINT (Flength (sequence)), ii = 0, starting = XINT (start);
+Elemcount ending = NILP (end) ? length : XINT (end), encountered = 0;
+Lisp_Object *storage;
+struct gcpro gcpro1;
+check_sequence_range (sequence, start, end, make_integer (length));
+storage = alloca_array (Lisp_Object, ending - starting);
+{
+EXTERNAL_LIST_LOOP_2 (elt, sequence)
+{
+if (starting <= ii && ii < ending)
+{
+storage[ii - starting] = elt;
+}
+ii++;
+}
+}
+GCPRO1 (storage[0]);
+gcpro1.nvars = ending - starting;
+for (ii = ending - 1; ii >= starting; ii--)
+{
+if (check_test (test, key, item, storage[ii - starting])
+== test_not_unboundp)
+{
+encountered++;
+}
+}
+UNGCPRO;
+return make_integer (encountered);
+}
+static Lisp_Object
+string_count_from_end (Lisp_Object item, Lisp_Object sequence,
+check_test_func_t check_test, Boolint test_not_unboundp,
+Lisp_Object test, Lisp_Object key,
+Lisp_Object start, Lisp_Object end)
+{
+Elemcount length = string_char_length (sequence), ii = 0;
+Elemcount starting = XINT (start), ending = NILP (end) ? length : XINT (end);
+Elemcount encountered = 0;
+Ibyte *cursor = XSTRING_DATA (sequence);
+Ibyte *endp = cursor + XSTRING_LENGTH (sequence);
+Ichar *storage;
+check_sequence_range (sequence, start, end, make_integer (length));
+storage = alloca_array (Ichar, ending - starting);
+while (cursor < endp && ii < ending)
+{
+if (starting <= ii && ii < ending)
+{
+storage [ii - starting] = itext_ichar (cursor);
+}
+ii++;
+INC_IBYTEPTR (cursor);
+}
+for (ii = ending - 1; ii >= starting; ii--)
+{
+if (check_test (test, key, item, make_char (storage [ii - starting]))
+== test_not_unboundp)
+{
+encountered++;
+}
+}
+return make_integer (encountered);
+}
+DEFUN ("count", Fcount, 2, MANY, 0, /*
+Count the number of occurrences of ITEM in SEQUENCE.
+See `remove*' for the meaning of the keywords.
+arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) END FROM-END TEST-NOT)
+*/
+(int nargs, Lisp_Object *args))
+{
+Lisp_Object tail = Qnil;
+/* count_with_tail() accepts more keywords than we do, check those we've
+been given. */
+PARSE_KEYWORDS (Fcount, nargs, args, 8,
+		  (test, test_not, if_, if_not, key, start, end, from_end),
+		  NULL);
+return count_with_tail (&tail, nargs, args, Qcount);
+}
 /*** string functions. ***/
 DEFUN ("string-equal", Fstring_equal, 2, 2, 0, /*
 Return t if two strings have identical contents.
 Case is significant.  Text properties are ignored.
 }
 Lisp_Object
 safe_copy_tree (Lisp_Object arg, Lisp_Object vecp, int depth)
 {
-if (depth > 200)
+if (depth + lisp_eval_depth > max_lisp_eval_depth)
 stack_overflow ("Stack overflow in copy-tree", arg);
 if (CONSP (arg))
 {
 Lisp_Object rest;
 return tail;
 }
 return Qnil;
 }
+/* Return the first index of ITEM in LIST. In CONS_OUT, return the cons cell
+before that containing the element. If the element is in the first cons
+cell, return Qnil in CONS_OUT.  TEST, KEY, START, END are as in
+#'remove*; CHECK_TEST and TEST_NOT_UNBOUNDP should have been initialized
+with get_check_match_function() or get_check_test_function().  A non-zero
+REVERSE_TEST_ORDER means call TEST with the element from LIST as its
+first argument and ITEM as its second. Error if LIST is ill-formed, or
+circular. */
+static Lisp_Object
+list_position_cons_before (Lisp_Object *cons_out,
+Lisp_Object item, Lisp_Object list,
+check_test_func_t check_test,
+Boolint test_not_unboundp,
+Lisp_Object test, Lisp_Object key,
+Boolint reverse_test_order,
+Lisp_Object start, Lisp_Object end)
+{
+struct gcpro gcpro1, gcpro2;
+Lisp_Object elt = Qnil, tail = list, tail_before = Qnil;
+Elemcount len, ii = 0, starting = XINT (start);
+Elemcount ending = NILP (end) ? EMACS_INT_MAX : XINT (end);
+GCPRO2 (elt, tail);
+if (check_test == check_eq_nokey)
+{
+/* TEST is #'eq, no need to call any C functions, and the test order
+won't be visible. */
+EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, list, tail, len)
+	{
+if (starting <= ii && ii < ending &&
+EQ (item, elt) == test_not_unboundp)
+{
+*cons_out = tail_before;
+RETURN_UNGCPRO (make_integer (ii));
+}
+else
+{
+if (ii >= ending)
+{
+break;
+}
+}
+ii++;
+tail_before = tail;
+	}
+}
+else
+{
+EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, list, tail, len)
+{
+if (starting <= ii && ii < ending &&
+(reverse_test_order ?
+check_test (test, key, elt, item) :
+check_test (test, key, item, elt)) == test_not_unboundp)
+{
+*cons_out = tail_before;
+RETURN_UNGCPRO (make_integer (ii));
+}
+else
+{
+if (ii >= ending)
+{
+break;
+}
+}
+ii++;
+tail_before = tail;
+}
+}
+RETURN_UNGCPRO (Qnil);
+}
+DEFUN ("member*", FmemberX, 2, MANY, 0, /*
+Return the first sublist of LIST with car ITEM, or nil if no such sublist.
+The keyword :test specifies a two-argument function that is used to compare
+ITEM with elements in LIST; if omitted, it defaults to `eql'.
+The keyword :test-not is similar, but specifies a negated function.  That
+is, ITEM is considered equal to an element in LIST if the given function
+returns nil.  Common Lisp deprecates :test-not, and if both are specified,
+XEmacs signals an error.
+:key specifies a one-argument function that transforms elements of LIST into
+\"comparison keys\" before the test predicate is applied.  For example,
+if :key is #'car, then ITEM is compared with the car of elements from LIST.
+The :key function, however, is not applied to ITEM, and does not affect the
+elements in the returned list, which are taken directly from the elements in
+LIST.
+arguments: (ITEM LIST &key (TEST #'eql) TEST-NOT (KEY #'identity))
+*/
+(int nargs, Lisp_Object *args))
+{
+Lisp_Object item = args[0], list = args[1], result = Qnil, position0;
+Boolint test_not_unboundp = 1;
+check_test_func_t check_test = NULL;
+PARSE_KEYWORDS (FmemberX, nargs, args, 5, (test, if_not, if_, test_not, key),
+		  NULL);
+check_test = get_check_test_function (item, &test, test_not, if_, if_not,
+					key, &test_not_unboundp);
+position0
+= list_position_cons_before (&result, item, list, check_test,
+test_not_unboundp, test, key, 0, Qzero, Qnil);
+return CONSP (result) ? XCDR (result) : ZEROP (position0) ? list : Qnil;
+}
+/* This macro might eventually find a better home than here. */
+#define CHECK_KEY_ARGUMENT(key)                                         \
+do {								\
+if (NILP (key))							\
+	{								\
+	  key = Qidentity;						\
+	}								\
+\
+if (!EQ (key, Qidentity))                                         \
+{                                                               \
+key = indirect_function (key, 1);                             \
+if (EQ (key, XSYMBOL_FUNCTION (Qidentity)))                   \
+{                                                           \
+key = Qidentity;                                          \
+}                                                           \
+}                                                               \
+} while (0)
+#define KEY(key, item) (EQ (Qidentity, key) ? item : \
+IGNORE_MULTIPLE_VALUES (call1 (key, item)))
+DEFUN ("adjoin", Fadjoin, 2, MANY, 0, /*
+Return ITEM consed onto the front of LIST, if not already in LIST.
+Otherwise, return LIST unmodified.
+See `member*' for the meaning of the keywords.
+arguments: (ITEM LIST &key (TEST #'eql) (KEY #'identity) TEST-NOT)
+*/
+(int nargs, Lisp_Object *args))
+{
+Lisp_Object item = args[0], list = args[1], keyed = Qnil, ignore = Qnil;
+struct gcpro gcpro1;
+Boolint test_not_unboundp = 1;
+check_test_func_t check_test = NULL;
+PARSE_KEYWORDS (Fadjoin, nargs, args, 3, (test, key, test_not),
+		  NULL);
+CHECK_KEY_ARGUMENT (key);
+keyed = KEY (key, item);
+GCPRO1 (keyed);
+check_test = get_check_test_function (keyed, &test, test_not, Qnil, Qnil,
+					key, &test_not_unboundp);
+if (NILP (list_position_cons_before (&ignore, keyed, list, check_test,
+test_not_unboundp, test, key, 0, Qzero,
+Qnil)))
+{
+RETURN_UNGCPRO (Fcons (item, list));
+}
+RETURN_UNGCPRO (list);
+}
 DEFUN ("assoc", Fassoc, 2, 2, 0, /*
 Return non-nil if KEY is `equal' to the car of an element of ALIST.
 The value is actually the element of ALIST whose car equals KEY.
 */
 (key, alist))
 	return elt;
 }
 return Qnil;
 }
+DEFUN ("assoc*", FassocX, 2, MANY, 0, /*
+Find the first item whose car matches ITEM in ALIST.
+See `member*' for the meaning of :test, :test-not and :key.
+arguments: (ITEM ALIST &key (TEST #'eql) (KEY #'identity) TEST-NOT)
+*/
+(int nargs, Lisp_Object *args))
+{
+Lisp_Object item = args[0], alist = args[1];
+Boolint test_not_unboundp = 1;
+check_test_func_t check_test = NULL;
+PARSE_KEYWORDS (FassocX, nargs, args, 5, (test, if_, if_not, test_not, key),
+		  NULL);
+check_test = get_check_test_function (item, &test, test_not, if_, if_not,
+					key, &test_not_unboundp);
+if (check_test == check_eq_nokey)
+{
+/* TEST is #'eq, no need to call any C functions. */
+EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
+	{
+	  if (EQ (item, elt_car) == test_not_unboundp)
+	    {
+	      return elt;
+	    }
+	}
+}
+else
+{
+Lisp_Object tailed = alist;
+struct gcpro gcpro1;
+GCPRO1 (tailed);
+{
+EXTERNAL_ALIST_LOOP_5 (elt, elt_car, elt_cdr, alist, tail)
+{
+tailed = tail;
+if (check_test (test, key, item, elt_car) == test_not_unboundp)
+{
+RETURN_UNGCPRO (elt);
+}
+}
+}
+UNGCPRO;
+}
+return Qnil;
+}
 DEFUN ("rassoc", Frassoc, 2, 2, 0, /*
 Return non-nil if VALUE is `equal' to the cdr of an element of ALIST.
 The value is actually the element of ALIST whose cdr equals VALUE.
 */
 (value, alist))
 	return elt;
 }
 return Qnil;
 }
+DEFUN ("rassoc*", FrassocX, 2, MANY, 0, /*
+Find the first item whose cdr matches ITEM in ALIST.
+See `member*' for the meaning of :test, :test-not and :key.
+arguments: (ITEM ALIST &key (TEST #'eql) (KEY #'identity) TEST-NOT)
+*/
+(int nargs, Lisp_Object *args))
+{
+Lisp_Object item = args[0], alist = args[1];
+Boolint test_not_unboundp = 1;
+check_test_func_t check_test = NULL;
+PARSE_KEYWORDS (FrassocX, nargs, args, 5, (test, if_, if_not, test_not, key),
+		  NULL);
+check_test = get_check_test_function (item, &test, test_not, if_, if_not,
+					key, &test_not_unboundp);
+if (check_test == check_eq_nokey)
+{
+/* TEST is #'eq, no need to call any C functions. */
+EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist)
+	{
+	  if (EQ (item, elt_cdr) == test_not_unboundp)
+	    {
+	      return elt;
+	    }
+	}
+}
+else
+{
+struct gcpro gcpro1;
+Lisp_Object tailed = alist;
+GCPRO1 (tailed);
+{
+EXTERNAL_ALIST_LOOP_5 (elt, elt_car, elt_cdr, alist, tail)
+{
+tailed = tail;
+if (check_test (test, key, item, elt_cdr) == test_not_unboundp)
+{
+RETURN_UNGCPRO (elt);
+}
+}
+}
+UNGCPRO;
+}
+return Qnil;
+}
+/* This is the implementation of both #'find and #'position. */
+static Lisp_Object
+position (Lisp_Object *object_out, Lisp_Object item, Lisp_Object sequence,
+check_test_func_t check_test, Boolint test_not_unboundp,
+Lisp_Object test, Lisp_Object key, Lisp_Object start, Lisp_Object end,
+Lisp_Object from_end, Lisp_Object default_, Lisp_Object caller)
+{
+Lisp_Object result = Qnil;
+Elemcount starting = 0, ending = EMACS_INT_MAX, len, ii = 0;
+CHECK_SEQUENCE (sequence);
+CHECK_NATNUM (start);
+starting = INTP (start) ? XINT (start) : 1 + EMACS_INT_MAX;
+if (!NILP (end))
+{
+CHECK_NATNUM (end);
+ending = INTP (end) ? XINT (end) : 1 + EMACS_INT_MAX;
+}
+*object_out = default_;
+if (CONSP (sequence))
+{
+Lisp_Object elt, tail = Qnil;
+struct gcpro gcpro1;
+if (!(starting < ending))
+	{
+	  check_sequence_range (sequence, start, end, Flength (sequence));
+	  /* starting could be equal to ending, in which case nil is what
+	     we want to return. */
+	  return Qnil;
+	}
+GCPRO1 (tail);
+{
+EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tail, len)
+{
+if (starting <= ii && ii < ending
+&& check_test (test, key, item, elt) == test_not_unboundp)
+{
+result = make_integer (ii);
+*object_out = elt;
+if (NILP (from_end))
+{
+UNGCPRO;
+return result;
+}
+}
+else if (ii == ending)
+{
+break;
+}
+ii++;
+}
+}
+UNGCPRO;
+if (ii < starting || (ii < ending && !NILP (end)))
+	{
+	  check_sequence_range (sequence, start, end, Flength (sequence));
+	}
+}
+else if (STRINGP (sequence))
+{
+Ibyte *startp = XSTRING_DATA (sequence), *cursor = startp;
+Bytecount byte_len = XSTRING_LENGTH (sequence), cursor_offset = 0;
+Lisp_Object character = Qnil;
+while (cursor_offset < byte_len && ii < ending)
+	{
+	  if (ii >= starting)
+	    {
+	      character = make_char (itext_ichar (cursor));
+	      if (check_test (test, key, item, character) == test_not_unboundp)
+		{
+		  result = make_integer (ii);
+		  *object_out = character;
+		  if (NILP (from_end))
+		    {
+		      return result;
+		    }
+		}
+	      startp = XSTRING_DATA (sequence);
+	      cursor = startp + cursor_offset;
+	      if (byte_len != XSTRING_LENGTH (sequence)
+		  || !valid_ibyteptr_p (cursor))
+		{
+		  mapping_interaction_error (caller, sequence);
+		}
+	    }
+	  INC_IBYTEPTR (cursor);
+	  cursor_offset = cursor - startp;
+	  ii++;
+	}
+if (ii < starting || (ii < ending && !NILP (end)))
+	{
+	  check_sequence_range (sequence, start, end, Flength (sequence));
+	}
+}
+else
+{
+Lisp_Object object = Qnil;
+len = XINT (Flength (sequence));
+check_sequence_range (sequence, start, end, make_int (len));
+ending = min (ending, len);
+if (0 == len)
+	{
+	  /* Catches the case where we have nil.  */
+	  return result;
+	}
+if (NILP (from_end))
+	{
+	  for (ii = starting; ii < ending; ii++)
+	    {
+	      object = Faref (sequence, make_int (ii));
+	      if (check_test (test, key, item, object) == test_not_unboundp)
+		{
+		  result = make_integer (ii);
+		  *object_out = object;
+		  return result;
+		}
+	    }
+	}
+else
+	{
+	  for (ii = ending - 1; ii >= starting; ii--)
+	    {
+	      object = Faref (sequence, make_int (ii));
+	      if (check_test (test, key, item, object) == test_not_unboundp)
+		{
+		  result = make_integer (ii);
+		  *object_out = object;
+		  return result;
+		}
+	    }
+	}
+}
+return result;
+}
+DEFUN ("position", Fposition, 2, MANY, 0, /*
+Return the index of the first occurrence of ITEM in SEQUENCE.
+Return nil if not found. See `remove*' for the meaning of the keywords.
+arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) FROM-END TEST-NOT)
+*/
+(int nargs, Lisp_Object *args))
+{
+Lisp_Object object = Qnil, item = args[0], sequence = args[1];
+Boolint test_not_unboundp = 1;
+check_test_func_t check_test = NULL;
+PARSE_KEYWORDS (Fposition, nargs, args, 8,
+		  (test, if_, test_not, if_not, key, start, end, from_end),
+		  (start = Qzero));
+check_test = get_check_test_function (item, &test, test_not, if_, if_not,
+					key, &test_not_unboundp);
+return position (&object, item, sequence, check_test, test_not_unboundp,
+test, key, start, end, from_end, Qnil, Qposition);
+}
+DEFUN ("find", Ffind, 2, MANY, 0, /*
+Find the first occurrence of ITEM in SEQUENCE.
+Return the matching ITEM, or nil if not found.  See `remove*' for the
+meaning of the keywords.
+The keyword :default, not specified by Common Lisp, designates an object to
+return instead of nil if ITEM is not found.
+arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) DEFAULT FROM-END TEST-NOT)
+*/
+(int nargs, Lisp_Object *args))
+{
+Lisp_Object object = Qnil, item = args[0], sequence = args[1];
+Boolint test_not_unboundp = 1;
+check_test_func_t check_test = NULL;
+PARSE_KEYWORDS (Fposition, nargs, args, 9,
+		  (test, if_, test_not, if_not, key, start, end, from_end,
+default_),
+		  (start = Qzero));
+check_test = get_check_test_function (item, &test, test_not, if_, if_not,
+					key, &test_not_unboundp);
+position (&object, item, sequence, check_test, test_not_unboundp,
+test, key, start, end, from_end, Qnil, Qposition);
+return object;
+}
 DEFUN ("delete", Fdelete, 2, 2, 0, /*
 Delete by side effect any occurrences of ELT as a member of LIST.
 The modified LIST is returned.  Comparison is done with `equal'.
 If the first member of LIST is ELT, there is no way to remove it by side
 	}
 }
 return list;
 }
+DEFUN ("delete*", FdeleteX, 2, MANY, 0, /*
+Remove all occurrences of ITEM in SEQUENCE, destructively.
+If SEQUENCE is a non-nil list, this modifies the list directly.  A non-list
+SEQUENCE will not be destructively modified, rather, if ITEM occurs in it, a
+new SEQUENCE of the same type without ITEM will be returned.
+See `remove*' for a non-destructive alternative, and for explanation of the
+keyword arguments.
+arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) FROM-END COUNT TEST-NOT)
+*/
+(int nargs, Lisp_Object *args))
+{
+Lisp_Object item = args[0], sequence = args[1], tail = sequence;
+Elemcount starting = 0, ending = EMACS_INT_MAX, counting = EMACS_INT_MAX;
+Elemcount len, ii = 0, encountered = 0, presenting = 0;
+Boolint test_not_unboundp = 1;
+check_test_func_t check_test = NULL;
+struct gcpro gcpro1;
+PARSE_KEYWORDS (FdeleteX, nargs, args, 9,
+		  (test, if_not, if_, test_not, key, start, end, from_end,
+		   count), (start = Qzero, count = Qunbound));
+CHECK_SEQUENCE (sequence);
+CHECK_NATNUM (start);
+starting = BIGNUMP (start) ? 1 + EMACS_INT_MAX : XINT (start);
+if (!NILP (end))
+{
+CHECK_NATNUM (end);
+ending = BIGNUMP (end) ? 1 + EMACS_INT_MAX : XINT (end);
+}
+if (!UNBOUNDP (count))
+{
+if (!NILP (count))
+	{
+	  CHECK_INTEGER (count);
+if (INTP (count))
+{
+counting = XINT (count);
+}
+#ifdef HAVE_BIGNUM
+else
+{
+counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ?
+1 + EMACS_INT_MAX : EMACS_INT_MIN - 1;
+}
+#endif
+	  if (counting < 1)
+	    {
+	      return sequence;
+	    }
+	}
+}
+check_test = get_check_test_function (item, &test, test_not, if_, if_not,
+					key, &test_not_unboundp);
+if (CONSP (sequence))
+{
+Lisp_Object prev_tail_list_elt = Qnil, list_elt = Qnil;
+Elemcount list_len = 0, deleted = 0;
+if (!NILP (count) && !NILP (from_end))
+	{
+	  /* Both COUNT and FROM-END were specified; we need to traverse the
+	     list twice. */
+	  Lisp_Object present = count_with_tail (&list_elt, nargs, args,
+						 QdeleteX);
+	  if (ZEROP (present))
+	    {
+	      return sequence;
+	    }
+	  presenting = XINT (present);
+	  /* If there are fewer items in the list than we have permission to
+	     delete, we don't need to differentiate between the :from-end
+	     nil and :from-end t cases. Otherwise, presenting is the number
+	     of matching items we need to ignore before we start to
+	     delete. */
+	  presenting = presenting <= counting ? 0 : presenting - counting;
+	}
+GCPRO1 (tail);
+ii = -1;
+{
+EXTERNAL_LIST_LOOP_4_NO_DECLARE (list_elt, sequence, tail, list_len)
+{
+ii++;
+if (starting <= ii && ii < ending &&
+(check_test (test, key, item, list_elt) == test_not_unboundp)
+&& (presenting ? encountered++ >= presenting
+: encountered++ < counting))
+{
+if (NILP (prev_tail_list_elt))
+{
+sequence = XCDR (tail);
+}
+else
+{
+XSETCDR (prev_tail_list_elt, XCDR (tail));
+}
+/* Keep tortoise from ever passing hare. */
+list_len = 0;
+deleted++;
+}
+else
+{
+prev_tail_list_elt = tail;
+if (ii >= ending || (!presenting && encountered > counting))
+{
+break;
+}
+}
+}
+}
+UNGCPRO;
+if ((ii < starting || (ii < ending && !NILP (end))) &&
+	  !(presenting ? encountered == presenting : encountered == counting))
+	{
+	  check_sequence_range (args[1], start, end,
+make_int (deleted + XINT (Flength (args[1]))));
+	}
+return sequence;
+}
+else if (STRINGP (sequence))
+{
+Ibyte *staging = alloca_ibytes (XSTRING_LENGTH (sequence));
+Ibyte *staging_cursor = staging, *startp = XSTRING_DATA (sequence);
+Ibyte *cursor = startp;
+Bytecount cursor_offset = 0, byte_len = XSTRING_LENGTH (sequence);
+Lisp_Object character, result = sequence;
+if (!NILP (count) && !NILP (from_end))
+	{
+	  Lisp_Object present = count_with_tail (&character, nargs, args,
+						 QdeleteX);
+	  if (ZEROP (present))
+	    {
+	      return sequence;
+	    }
+	  presenting = XINT (present);
+	  /* If there are fewer items in the list than we have permission to
+	     delete, we don't need to differentiate between the :from-end
+	     nil and :from-end t cases. Otherwise, presenting is the number
+	     of matching items we need to ignore before we start to
+	     delete. */
+	  presenting = presenting <= counting ? 0 : presenting - counting;
+	}
+ii = 0;
+while (cursor_offset < byte_len)
+	{
+	  if (ii >= starting && ii < ending)
+	    {
+	      character = make_char (itext_ichar (cursor));
+	      if ((check_test (test, key, item, character)
+		   == test_not_unboundp)
+		  && (presenting ? encountered++ >= presenting :
+		      encountered++ < counting))
+		{
+		  DO_NOTHING;
+		}
+	      else
+		{
+		  staging_cursor
+		    += set_itext_ichar (staging_cursor, XCHAR (character));
+		}
+	      startp = XSTRING_DATA (sequence);
+	      cursor = startp + cursor_offset;
+	      if (byte_len != XSTRING_LENGTH (sequence)
+		  || !valid_ibyteptr_p (cursor))
+		{
+		  mapping_interaction_error (QdeleteX, sequence);
+		}
+	    }
+	  else
+	    {
+	      staging_cursor += itext_copy_ichar (cursor, staging_cursor);
+	    }
+	  INC_IBYTEPTR (cursor);
+	  cursor_offset = cursor - startp;
+	  ii++;
+	}
+if (ii < starting || (ii < ending && !NILP (end)))
+	{
+	  check_sequence_range (sequence, start, end, Flength (sequence));
+	}
+if (0 != encountered)
+	{
+	  result = make_string (staging, staging_cursor - staging);
+	  copy_string_extents (result, sequence, 0, 0,
+			       staging_cursor - staging);
+	  sequence = result;
+	}
+return sequence;
+}
+else
+{
+Lisp_Object position0 = Qnil, object = Qnil;
+Lisp_Object *staging = NULL, *staging_cursor, *staging_limit;
+Elemcount positioning;
+len = XINT (Flength (sequence));
+check_sequence_range (sequence, start, end, make_int (len));
+position0 = position (&object, item, sequence, check_test,
+test_not_unboundp, test, key, start, end,
+from_end, Qnil, QdeleteX);
+if (NILP (position0))
+	{
+	  return sequence;
+	}
+ending = min (ending, len);
+positioning = XINT (position0);
+encountered = 1;
+if (NILP (from_end))
+	{
+	  staging = alloca_array (Lisp_Object, len - 1);
+	  staging_cursor = staging;
+	  ii = 0;
+	  while (ii < positioning)
+	    {
+	      *staging_cursor++ = Faref (sequence, make_int (ii));
+	      ii++;
+	    }
+	  ii = positioning + 1;
+	  while (ii < ending)
+	    {
+	      object = Faref (sequence, make_int (ii));
+	      if (encountered < counting
+		  && (check_test (test, key, item, object)
+		      == test_not_unboundp))
+		{
+		  encountered++;
+		}
+	      else
+		{
+		  *staging_cursor++ = object;
+		}
+	      ii++;
+	    }
+	  while (ii < len)
+	    {
+	      *staging_cursor++ = Faref (sequence, make_int (ii));
+	      ii++;
+	    }
+	}
+else
+	{
+	  staging = alloca_array (Lisp_Object, len - 1);
+	  staging_cursor = staging_limit = staging + len - 1;
+	  ii = len - 1;
+	  while (ii > positioning)
+	    {
+	      *--staging_cursor = Faref (sequence, make_int (ii));
+	      ii--;
+	    }
+	  ii = positioning - 1;
+	  while (ii >= starting)
+	    {
+	      object = Faref (sequence, make_int (ii));
+	      if (encountered < counting
+		  && (check_test (test, key, item, object) ==
+		      test_not_unboundp))
+		{
+		  encountered++;
+		}
+	      else
+		{
+		  *--staging_cursor = object;
+		}
+	      ii--;
+	    }
+	  while (ii >= 0)
+	    {
+	      *--staging_cursor = Faref (sequence, make_int (ii));
+	      ii--;
+	    }
+	  staging = staging_cursor;
+	  staging_cursor = staging_limit;
+	}
+if (VECTORP (sequence))
+	{
+	  return Fvector (staging_cursor - staging, staging);
+	}
+else if (BIT_VECTORP (sequence))
+	{
+	  return Fbit_vector (staging_cursor - staging, staging);
+	}
+/* A nil sequence will have given us a nil #'position,
+	 above.  */
+ABORT ();
+return Qnil;
+}
+}
+DEFUN ("remove*", FremoveX, 2, MANY, 0, /*
+Remove all occurrences of ITEM in SEQUENCE, non-destructively.
+If SEQUENCE is a list, `remove*' makes a copy if that is necessary to avoid
+corrupting the original SEQUENCE.
+The keywords :test and :test-not specify two-argument test and negated-test
+predicates, respectively; :test defaults to `eql'.  :key specifies a
+one-argument function that transforms elements of SEQUENCE into \"comparison
+keys\" before the test predicate is applied.  See `member*' for more
+information on these keywords.
+:start and :end, if given, specify indices of a subsequence of SEQUENCE to
+be processed.  Indices are 0-based and processing involves the subsequence
+starting at the index given by :start and ending just before the index given
+by :end.
+:count, if given, limits the number of items removed to the number
+specified.  :from-end, if given, causes processing to proceed starting from
+the end instead of the beginning; in this case, this matters only if :count
+is given.
+arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) FROM-END COUNT TEST-NOT)
+*/
+(int nargs, Lisp_Object *args))
+{
+Lisp_Object item = args[0], sequence = args[1], matched_count = Qnil,
+tail = Qnil;
+Elemcount starting = 0, ending = EMACS_INT_MAX, counting = EMACS_INT_MAX;
+Elemcount len, ii = 0, encountered = 0, presenting = 0;
+Boolint test_not_unboundp = 1;
+check_test_func_t check_test = NULL;
+struct gcpro gcpro1;
+PARSE_KEYWORDS (FremoveX, nargs, args, 9,
+		  (test, if_not, if_, test_not, key, start, end, from_end,
+		   count), (start = Qzero));
+if (!CONSP (sequence))
+{
+return FdeleteX (nargs, args);
+}
+CHECK_NATNUM (start);
+starting = BIGNUMP (start) ? 1 + EMACS_INT_MAX : XINT (start);
+if (!NILP (end))
+{
+CHECK_NATNUM (end);
+ending = BIGNUMP (end) ? 1 + EMACS_INT_MAX : XINT (end);
+}
+if (!NILP (count))
+{
+CHECK_INTEGER (count);
+if (INTP (count))
+{
+counting = XINT (count);
+}
+#ifdef HAVE_BIGNUM
+else
+{
+counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ?
+1 + EMACS_INT_MAX : -1 + EMACS_INT_MIN;
+}
+#endif
+if (counting <= 0)
+	{
+	  return sequence;
+	}
+}
+check_test = get_check_test_function (item, &test, test_not, if_, if_not,
+					key, &test_not_unboundp);
+matched_count = count_with_tail (&tail, nargs, args, QremoveX);
+if (!ZEROP (matched_count))
+{
+Lisp_Object elt, tailing = Qnil, result = Qnil, result_tail = Qnil;
+GCPRO1 (tailing);
+if (!NILP (count) && !NILP (from_end))
+	{
+	  presenting = XINT (matched_count);
+	  /* If there are fewer matching elements in the list than we have
+	     permission to delete, we don't need to differentiate between
+	     the :from-end nil and :from-end t cases. Otherwise, presenting
+	     is the number of matching items we need to ignore before we
+	     start to delete. */
+	  presenting = presenting <= counting ? 0 : presenting - counting;
+	}
+{
+EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tailing, len)
+{
+if (EQ (tail, tailing))
+{
+if (NILP (result))
+{
+RETURN_UNGCPRO (XCDR (tail));
+}
+XSETCDR (result_tail, XCDR (tail));
+RETURN_UNGCPRO (result);
+}
+else if (starting <= ii && ii < ending &&
+(check_test (test, key, item, elt) == test_not_unboundp)
+&& (presenting ? encountered++ >= presenting
+: encountered++ < counting))
+{
+DO_NOTHING;
+}
+else if (NILP (result))
+{
+result = result_tail = Fcons (elt, Qnil);
+}
+else
+{
+XSETCDR (result_tail, Fcons (elt, Qnil));
+result_tail = XCDR (result_tail);
+}
+if (ii == ending)
+{
+break;
+}
+ii++;
+}
+}
+UNGCPRO;
+if (ii < starting || (ii < ending && !NILP (end)))
+	{
+	  check_sequence_range (args[0], start, end, Flength (args[0]));
+	}
+return result;
+}
+return sequence;
+}
 DEFUN ("remassoc", Fremassoc, 2, 2, 0, /*
 Delete by side effect any elements of ALIST whose car is `equal' to KEY.
 The modified ALIST is returned.  If the first member of ALIST has a car
 that is `equal' to KEY, there is no way to remove it by side effect;
 therefore, write `(setq foo (remassoc key foo))' to be sure of changing
 LIST_LOOP_DELETE_IF (elt, alist,
 		       (CONSP (elt) &&
 			EQ_WITH_EBOLA_NOTICE (value, XCDR (elt))));
 return alist;
 }
+/* Remove duplicate elements between START and END from LIST, a non-nil
+list; if COPY is zero, do so destructively. Items to delete are selected
+according to the algorithm used when :from-end t is passed to
+#'delete-duplicates.  Error if LIST is ill-formed or circular.
+TEST and KEY are as in #'remove*; CHECK_TEST and TEST_NOT_UNBOUNDP should
+reflect them, having been initialised with get_check_match_function() or
+get_check_test_function(). */
+static Lisp_Object
+list_delete_duplicates_from_end (Lisp_Object list,
+				 check_test_func_t check_test,
+				 Boolint test_not_unboundp,
+				 Lisp_Object test, Lisp_Object key,
+				 Lisp_Object start,
+				 Lisp_Object end, Boolint copy)
+{
+Lisp_Object checking = Qnil, elt, tail, result = list;
+Lisp_Object keyed, positioned, position_cons = Qnil, result_tail;
+Elemcount len = XINT (Flength (list)), pos, starting = XINT (start);
+Elemcount ending = (NILP (end) ? len : XINT (end)), greatest_pos_seen = -1;
+Elemcount ii = 0;
+struct gcpro gcpro1, gcpro2;
+/* We can't delete (or remove) as we go, because that breaks START and
+END.  We could if END were nil, and that would change an ON(N + 2)
+algorithm to an ON^2 algorithm; list_position_cons_before() would need to
+be modified to return the cons *before* the one containing the item for
+that.  Here and now it doesn't matter, though, #'delete-duplicates is
+relatively expensive no matter what. */
+struct Lisp_Bit_Vector *deleting
+= (Lisp_Bit_Vector *) ALLOCA (sizeof (struct Lisp_Bit_Vector)
+				  + (sizeof (long)
+				     * (BIT_VECTOR_LONG_STORAGE (len)
+					- 1)));
+check_sequence_range (list, start, end, make_integer (len));
+deleting->size = len;
+memset (&(deleting->bits), 0,
+	  sizeof (long) * BIT_VECTOR_LONG_STORAGE (len));
+GCPRO2 (tail, keyed);
+{
+EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, list, tail, len)
+{
+if (!(starting <= ii && ii <= ending) || bit_vector_bit (deleting, ii))
+{
+ii++;
+continue;
+}
+keyed = KEY (key, elt);
+checking = XCDR (tail);
+pos = ii + 1;
+while (!NILP ((positioned = list_position_cons_before
+(&position_cons, keyed, checking, check_test,
+test_not_unboundp, test, key, 0,
+make_int (max (starting - pos, 0)),
+make_int (ending - pos)))))
+{
+pos = XINT (positioned) + pos;
+set_bit_vector_bit (deleting, pos, 1);
+greatest_pos_seen = max (greatest_pos_seen, pos);
+checking = NILP (position_cons) ?
+XCDR (checking) : XCDR (XCDR (position_cons));
+pos += 1;
+}
+ii++;
+}
+}
+UNGCPRO;
+ii = 0;
+if (greatest_pos_seen > -1)
+{
+if (copy)
+	{
+	  result = result_tail = Fcons (XCAR (list), Qnil);
+	  list = XCDR (list);
+	  ii = 1;
+	  {
+EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, list, tail, len)
+	      {
+		if (ii == greatest_pos_seen)
+		  {
+		    XSETCDR (result_tail, XCDR (tail));
+		    break;
+		  }
+		else if (!bit_vector_bit (deleting, ii))
+		  {
+		    XSETCDR (result_tail, Fcons (elt, Qnil));
+		    result_tail = XCDR (result_tail);
+		  }
+		ii++;
+	      }
+	  }
+	}
+else
+	{
+	  EXTERNAL_LIST_LOOP_DELETE_IF (elt0, list,
+					bit_vector_bit (deleting, ii++));
+	}
+}
+return result;
+}
+DEFUN ("delete-duplicates", Fdelete_duplicates, 1, MANY, 0, /*
+Remove all duplicate elements from SEQUENCE, destructively.
+If SEQUENCE is a list and has duplicates, modify and return it.  Note that
+SEQUENCE may start with an element to be deleted; because of this, if
+modifying a variable, be sure to write `(setq VARIABLE (delete-duplicates
+VARIABLE))' to be certain to have a list without duplicate elements.
+If SEQUENCE is an array and has duplicates, return a newly-allocated array
+of the same type comprising all unique elements of SEQUENCE.
+If there are no duplicate elements in SEQUENCE, return it unmodified.
+See `remove*' for the meaning of the keywords.  See `remove-duplicates' for
+a non-destructive version of this function.
+arguments: (SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) END FROM-END TEST-NOT)
+*/
+(int nargs, Lisp_Object *args))
+{
+Lisp_Object sequence = args[0], tail = sequence, keyed = Qnil, elt = Qnil;
+Lisp_Object elt0 = Qnil, positioned = Qnil, ignore = Qnil;
+Elemcount starting = 0, ending = EMACS_INT_MAX, len, ii = 0, jj = 0;
+Boolint test_not_unboundp = 1;
+check_test_func_t check_test = NULL;
+struct gcpro gcpro1, gcpro2;
+PARSE_KEYWORDS (Fdelete_duplicates, nargs, args, 6,
+		  (test, key, test_not, start, end, from_end),
+		  (start = Qzero));
+CHECK_SEQUENCE (sequence);
+CHECK_NATNUM (start);
+starting = BIGNUMP (start) ? 1 + EMACS_INT_MAX : XINT (start);
+if (!NILP (end))
+{
+CHECK_NATNUM (end);
+ending = BIGNUMP (end) ? 1 + EMACS_INT_MAX : XINT (end);
+}
+CHECK_KEY_ARGUMENT (key);
+get_check_match_function (&test, test_not, Qnil, Qnil, key,
+			    &test_not_unboundp, &check_test);
+if (CONSP (sequence))
+{
+if (NILP (from_end))
+	{
+	  Lisp_Object prev_tail = Qnil;
+Elemcount deleted = 0;
+	  GCPRO2 (tail, keyed);
+{
+EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tail, len)
+{
+if (starting <= ii && ii < ending)
+{
+keyed = KEY (key, elt);
+positioned
+= list_position_cons_before (&ignore, keyed,
+XCDR (tail), check_test,
+test_not_unboundp, test, key,
+0, make_int (max (starting
+- (ii + 1),
+0)),
+make_int (ending
+- (ii + 1)));
+if (!NILP (positioned))
+{
+sequence = XCDR (tail);
+deleted++;
+}
+else
+{
+break;
+}
+}
+else
+{
+break;
+}
+ii++;
+}
+}
+{
+EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt0, sequence, tail, len)
+{
+if (!(starting <= ii && ii <= ending))
+{
+prev_tail = tail;
+ii++;
+continue;
+}
+keyed = KEY (key, elt0);
+positioned
+= list_position_cons_before (&ignore, keyed, XCDR (tail),
+check_test, test_not_unboundp,
+test, key, 0,
+make_int (max (starting
+- (ii + 1), 0)),
+make_int (ending - (ii + 1)));
+if (!NILP (positioned))
+{
+/* We know this isn't the first iteration of the loop,
+because we advanced above to the point where we have at
+least one non-duplicate entry at the head of the
+list. */
+XSETCDR (prev_tail, XCDR (tail));
+len = 0;
+deleted++;
+}
+else
+{
+prev_tail = tail;
+if (ii >= ending)
+{
+break;
+}
+}
+ii++;
+}
+}
+	  UNGCPRO;
+	  if ((ii < starting || (ii < ending && !NILP (end))))
+	    {
+	      check_sequence_range (args[0], start, end,
+make_int (deleted
++ XINT (Flength (args[0]))));
+	    }
+	}
+else
+	{
+	  sequence = list_delete_duplicates_from_end (sequence, check_test,
+						      test_not_unboundp,
+						      test, key, start, end,
+						      0);
+	}
+}
+else if (STRINGP (sequence))
+{
+if (EQ (Qidentity, key))
+	{
+	  /* We know all the elements will be characters; set check_test to
+	     reflect that. This isn't useful if KEY is not #'identity, since
+	     it may return non-characters for the elements. */
+	  check_test = get_check_test_function (make_char ('a'),
+						&test, test_not,
+						Qnil, Qnil, key,
+						&test_not_unboundp);
+	}
+if (NILP (from_end))
+	{
+	  Bytecount byte_len = XSTRING_LENGTH (sequence), cursor_offset = 0;
+	  Ibyte *staging = alloca_ibytes (byte_len), *staging_cursor = staging;
+	  Ibyte *cursor = XSTRING_DATA (sequence), *startp = cursor;
+	  Elemcount deleted = 0;
+elt = Qnil;
+	  GCPRO1 (elt);
+	  while (cursor_offset < byte_len)
+	    {
+	      if (starting <= ii && ii < ending)
+		{
+		  Ibyte *cursor0 = cursor;
+		  Bytecount cursor0_offset;
+		  Boolint delete_this = 0;
+		  elt = KEY (key, make_char (itext_ichar (cursor)));
+		  INC_IBYTEPTR (cursor0);
+		  cursor0_offset = cursor0 - startp;
+		  for (jj = ii + 1; jj < ending && cursor0_offset < byte_len;
+		       jj++)
+		    {
+		      if (check_test (test, key, elt,
+				      make_char (itext_ichar (cursor0)))
+			  == test_not_unboundp)
+			{
+			  delete_this = 1;
+			  deleted++;
+			  break;
+			}
+		      startp = XSTRING_DATA (sequence);
+		      cursor0 = startp + cursor0_offset;
+		      if (byte_len != XSTRING_LENGTH (sequence)
+			  || !valid_ibyteptr_p (cursor0))
+			{
+			  mapping_interaction_error (Qdelete_duplicates,
+						     sequence);
+			}
+		      INC_IBYTEPTR (cursor0);
+		      cursor0_offset = cursor0 - startp;
+		    }
+		  startp = XSTRING_DATA (sequence);
+		  cursor = startp + cursor_offset;
+		  if (byte_len != XSTRING_LENGTH (sequence)
+		      || !valid_ibyteptr_p (cursor))
+		    {
+		      mapping_interaction_error (Qdelete_duplicates, sequence);
+		    }
+		  if (!delete_this)
+		    {
+		      staging_cursor
+			+= itext_copy_ichar (cursor, staging_cursor);
+		    }
+		}
+	      else
+		{
+		  staging_cursor += itext_copy_ichar (cursor, staging_cursor);
+		}
+	      INC_IBYTEPTR (cursor);
+	      cursor_offset = cursor - startp;
+	      ii++;
+	    }
+	  UNGCPRO;
+	  if (ii < starting || (ii < ending && !NILP (end)))
+	    {
+	      check_sequence_range (sequence, start, end, Flength (sequence));
+	    }
+	  if (0 != deleted)
+	    {
+	      sequence = make_string (staging, staging_cursor - staging);
+	    }
+	}
+else
+	{
+	  Elemcount deleted = 0;
+	  Ibyte *staging = alloca_ibytes ((len = string_char_length (sequence))
+* MAX_ICHAR_LEN);
+	  Ibyte *staging_cursor = staging, *startp = XSTRING_DATA (sequence);
+	  Ibyte *endp = startp + XSTRING_LENGTH (sequence);
+	  struct Lisp_Bit_Vector *deleting
+	    = (Lisp_Bit_Vector *) ALLOCA (sizeof (struct Lisp_Bit_Vector)
+					  + (sizeof (long)
+					     * (BIT_VECTOR_LONG_STORAGE (len)
+						- 1)));
+	  check_sequence_range (sequence, start, end, make_integer (len));
+	  /* For the from_end t case; transform contents to an array with
+	     elements addressable in constant time, use the same algorithm
+	     as for vectors. */
+	  deleting->size = len;
+	  memset (&(deleting->bits), 0,
+		  sizeof (long) * BIT_VECTOR_LONG_STORAGE (len));
+	  while (startp < endp)
+	    {
+	      itext_copy_ichar (startp, staging + (ii * MAX_ICHAR_LEN));
+	      INC_IBYTEPTR (startp);
+	      ii++;
+	    }
+	  GCPRO1 (elt);
+	  ending = min (ending, len);
+	  for (ii = ending - 1; ii >= starting; ii--)
+	    {
+	      elt = KEY (key, make_char (itext_ichar (staging +
+						      (ii * MAX_ICHAR_LEN))));
+	      for (jj = ii - 1; jj >= starting; jj--)
+		{
+		  if (check_test (test, key, elt,
+				  make_char (itext_ichar
+					     (staging + (jj * MAX_ICHAR_LEN))))
+		      == test_not_unboundp)
+		    {
+		      set_bit_vector_bit (deleting, ii, 1);
+		      deleted++;
+		      break;
+		    }
+		}
+	    }
+	  UNGCPRO;
+	  if (0 != deleted)
+	    {
+	      startp = XSTRING_DATA (sequence);
+	      for (ii = 0; ii < len; ii++)
+		{
+		  if (!bit_vector_bit (deleting, ii))
+		    {
+		      staging_cursor
+			+= itext_copy_ichar (startp, staging_cursor);
+		    }
+		  INC_IBYTEPTR (startp);
+		}
+	      sequence = make_string (staging, staging_cursor - staging);
+	    }
+	}
+}
+else if (VECTORP (sequence))
+{
+Elemcount deleted = 0;
+Lisp_Object *content = XVECTOR_DATA (sequence);
+struct Lisp_Bit_Vector *deleting;
+len = XVECTOR_LENGTH (sequence);
+check_sequence_range (sequence, start, end, make_integer (len));
+deleting = (Lisp_Bit_Vector *) ALLOCA (sizeof (struct Lisp_Bit_Vector)
++ (sizeof (long)
+* (BIT_VECTOR_LONG_STORAGE (len)
+- 1)));
+deleting->size = len;
+memset (&(deleting->bits), 0,
+	      sizeof (long) * BIT_VECTOR_LONG_STORAGE (len));
+GCPRO1 (elt);
+ending = min (ending, len);
+if (NILP (from_end))
+	{
+	  for (ii = starting; ii < ending; ii++)
+	    {
+	      elt = KEY (key, content[ii]);
+	      for (jj = ii + 1; jj < ending; jj++)
+		{
+		  if (check_test (test, key, elt, content[jj])
+		      == test_not_unboundp)
+		    {
+		      set_bit_vector_bit (deleting, ii, 1);
+		      deleted++;
+		      break;
+		    }
+		}
+	    }
+	}
+else
+	{
+	  for (ii = ending - 1; ii >= starting; ii--)
+	    {
+	      elt = KEY (key, content[ii]);
+	      for (jj = ii - 1; jj >= starting; jj--)
+		{
+		  if (check_test (test, key, elt, content[jj])
+		      == test_not_unboundp)
+		    {
+		      set_bit_vector_bit (deleting, ii, 1);
+		      deleted++;
+		      break;
+		    }
+		}
+	    }
+	}
+UNGCPRO;
+if (deleted)
+	{
+	  Lisp_Object res = make_vector (len - deleted, Qnil),
+	    *res_content = XVECTOR_DATA (res);
+	  for (ii = jj = 0; ii < len; ii++)
+	    {
+	      if (!bit_vector_bit (deleting, ii))
+		{
+		  res_content[jj++] = content[ii];
+		}
+	    }
+	  sequence = res;
+	}
+}
+else if (BIT_VECTORP (sequence))
+{
+Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence);
+Elemcount deleted = 0;
+/* I'm a little irritated at this. Basically, the only reasonable
+	 thing delete-duplicates should do if handed a bit vector is return
+	 something of maximum length two and minimum length 0 (because
+	 that's the possible number of distinct elements if EQ is regarded
+	 as identity, which it should be).  But to support arbitrary TEST
+	 and KEY arguments, which may be non-deterministic from our
+	 perspective, we need the same algorithm as for vectors. */
+struct Lisp_Bit_Vector *deleting;
+len = bit_vector_length (bv);
+if (EQ (Qidentity, key))
+	{
+	  /* We know all the elements will be bits; set check_test to
+	     reflect that. This isn't useful if KEY is not #'identity, since
+	     it may return non-bits for the elements. */
+	  check_test = get_check_test_function (Qzero, &test, test_not,
+						Qnil, Qnil, key,
+						&test_not_unboundp);
+	}
+check_sequence_range (sequence, start, end, make_integer (len));
+deleting = (Lisp_Bit_Vector *) ALLOCA (sizeof (struct Lisp_Bit_Vector)
++ (sizeof (long)
+* (BIT_VECTOR_LONG_STORAGE (len)
+- 1)));
+deleting->size = len;
+memset (&(deleting->bits), 0,
+	      sizeof (long) * BIT_VECTOR_LONG_STORAGE (len));
+ending = min (ending, len);
+GCPRO1 (elt);
+if (NILP (from_end))
+	{
+	  for (ii = starting; ii < ending; ii++)
+	    {
+	      elt = KEY (key, make_int (bit_vector_bit (bv, ii)));
+	      for (jj = ii + 1; jj < ending; jj++)
+		{
+		  if (check_test (test, key, elt,
+				  make_int (bit_vector_bit (bv, jj)))
+		      == test_not_unboundp)
+		    {
+		      set_bit_vector_bit (deleting, ii, 1);
+		      deleted++;
+		      break;
+		    }
+		}
+	    }
+	}
+else
+	{
+	  for (ii = ending - 1; ii >= starting; ii--)
+	    {
+	      elt = KEY (key, make_int (bit_vector_bit (bv, ii)));
+	      for (jj = ii - 1; jj >= starting; jj--)
+		{
+		  if (check_test (test, key, elt,
+				  make_int (bit_vector_bit (bv, jj)))
+		      == test_not_unboundp)
+		    {
+		      set_bit_vector_bit (deleting, ii, 1);
+		      deleted++;
+		      break;
+		    }
+		}
+	    }
+	}
+UNGCPRO;
+if (deleted)
+	{
+	  Lisp_Object res = make_bit_vector (len - deleted, Qzero);
+	  Lisp_Bit_Vector *resbv = XBIT_VECTOR (res);
+	  for (ii = jj = 0; ii < len; ii++)
+	    {
+	      if (!bit_vector_bit (deleting, ii))
+		{
+		  set_bit_vector_bit (resbv, jj++, bit_vector_bit (bv, ii));
+		}
+	    }
+	  sequence = res;
+	}
+}
+return sequence;
+}
+DEFUN ("remove-duplicates", Fremove_duplicates, 1, MANY, 0, /*
+Remove duplicate elements from SEQUENCE, non-destructively.
+If there are no duplicate elements in SEQUENCE, return it unmodified;
+otherwise, return a new object.  If SEQUENCE is a list, the new object may
+share list structure with SEQUENCE.
+See `remove*' for the meaning of the keywords.
+arguments: (SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) END FROM-END TEST-NOT)
+*/
+(int nargs, Lisp_Object *args))
+{
+Lisp_Object sequence = args[0], tail = sequence, keyed, positioned = Qnil;
+Lisp_Object result = sequence, result_tail = result, cursor = Qnil;
+Lisp_Object cons_with_shared_tail = Qnil, elt, elt0;
+Elemcount starting = 0, ending = EMACS_INT_MAX, len, ii = 0;
+Boolint test_not_unboundp = 1;
+check_test_func_t check_test = NULL;
+struct gcpro gcpro1, gcpro2, gcpro3;
+PARSE_KEYWORDS (Fremove_duplicates, nargs, args, 6,
+		  (test, key, test_not, start, end, from_end),
+		  (start = Qzero));
+CHECK_SEQUENCE (sequence);
+if (!CONSP (sequence))
+{
+return Fdelete_duplicates (nargs, args);
+}
+CHECK_NATNUM (start);
+starting = BIGNUMP (start) ? 1 + EMACS_INT_MAX : XINT (start);
+if (!NILP (end))
+{
+CHECK_NATNUM (end);
+ending = BIGNUMP (end) ? 1 + EMACS_INT_MAX : XINT (end);
+}
+if (NILP (key))
+{
+key = Qidentity;
+}
+get_check_match_function (&test, test_not, Qnil, Qnil, key,
+			    &test_not_unboundp, &check_test);
+if (NILP (from_end))
+{
+Lisp_Object ignore = Qnil;
+GCPRO3 (tail, keyed, result);
+{
+EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tail, len)
+{
+if (starting <= ii && ii <= ending)
+{
+keyed = KEY (key, elt);
+positioned
+= list_position_cons_before (&ignore, keyed, XCDR (tail),
+check_test, test_not_unboundp,
+test, key, 0,
+make_int (max (starting
+- (ii + 1), 0)),
+make_int (ending - (ii + 1)));
+if (!NILP (positioned))
+{
+sequence = result = result_tail = XCDR (tail);
+}
+else
+{
+break;
+}
+}
+else
+{
+break;
+}
+ii++;
+}
+}
+{
+EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt0, sequence, tail, len)
+{
+if (!(starting <= ii && ii <= ending))
+{
+ii++;
+continue;
+}
+/* For this algorithm, each time we encounter an object to be
+removed, copy the output list from the tail beyond the last
+removed cons to this one. Otherwise, the tail of the output list
+is shared with the input list, which is OK. */
+keyed = KEY (key, elt0);
+positioned
+= list_position_cons_before (&ignore, keyed, XCDR (tail),
+check_test, test_not_unboundp,
+test, key, 0,
+make_int (max (starting - (ii + 1),
+0)),
+make_int (ending - (ii + 1)));
+if (!NILP (positioned))
+{
+if (EQ (result, sequence))
+{
+result = cons_with_shared_tail
+= Fcons (XCAR (sequence), XCDR (sequence));
+}
+result_tail = cons_with_shared_tail;
+cursor = XCDR (cons_with_shared_tail);
+while (!EQ (cursor, tail) && !NILP (cursor))
+{
+XSETCDR (result_tail, Fcons (XCAR (cursor), Qnil));
+result_tail = XCDR (result_tail);
+cursor = XCDR (cursor);
+}
+XSETCDR (result_tail, XCDR (tail));
+cons_with_shared_tail = result_tail;
+}
+ii++;
+}
+}
+UNGCPRO;
+if ((ii < starting || (ii < ending && !NILP (end))))
+	{
+	  check_sequence_range (args[0], start, end, Flength (args[0]));
+	}
+}
+else
+{
+result = list_delete_duplicates_from_end (sequence, check_test,
+						test_not_unboundp, test, key,
+						start, end, 1);
+}
+return result;
+}
+#undef KEY
 DEFUN ("nreverse", Fnreverse, 1, 1, 0, /*
 Reverse SEQUENCE, destructively.
 Return the beginning of the reversed sequence, which will be a distinct Lisp
 object if SEQUENCE is a list with length greater than one.  See also
 for (counter = 0; counter < len; ++counter)                         \
 {                                                                 \
 c_array[counter] = make_int (bit_vector_bit (v, counter));      \
 }                                                                 \
 } while (0)
-/* This macro might eventually find a better home than here. */
-#define CHECK_KEY_ARGUMENT(key)                                         \
-do {								\
-if (NILP (key))							\
-	{								\
-	  key = Qidentity;						\
-	}								\
-\
-if (!EQ (key, Qidentity))                                         \
-{                                                               \
-key = indirect_function (key, 1);                             \
-}                                                               \
-} while (0)
 DEFUN ("merge", Fmerge, 4, MANY, 0, /*
 Destructively merge SEQUENCE-ONE and SEQUENCE-TWO, producing a new sequence.
 TYPE is the type of sequence to return.  PREDICATE is a `less-than'
 }
 int
 internal_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
 {
-if (depth > 200)
+if (depth + lisp_eval_depth > max_lisp_eval_depth)
 stack_overflow ("Stack overflow in equal", Qunbound);
 QUIT;
 if (EQ_WITH_EBOLA_NOTICE (obj1, obj2))
 return 1;
 /* Note that (equal 20 20.0) should be nil */
 }
 int
 internal_equalp (Lisp_Object obj1, Lisp_Object obj2, int depth)
 {
-if (depth > 200)
+if (depth + lisp_eval_depth > max_lisp_eval_depth)
 stack_overflow ("Stack overflow in equalp", Qunbound);
 QUIT;
 /* 1. Objects that are `eq' are equal.  This will catch the common case
 of two equal fixnums or the same object seen twice. */
 but that seems unlikely. */
 static int
 internal_old_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
 {
-if (depth > 200)
+if (depth + lisp_eval_depth > max_lisp_eval_depth)
 stack_overflow ("Stack overflow in equal", Qunbound);
 QUIT;
 if (HACKEQ_UNSAFE (obj1, obj2))
 return 1;
 /* Note that (equal 20 20.0) should be nil */
 }
 else if (LISTP (sequence))
 {
 Elemcount counting = 0;
-EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
+{
-{
+EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
-if (counting >= starting)
+{
-{
+if (counting >= starting)
-if (counting < ending)
+{
-{
+if (counting < ending)
-XSETCAR (tail, item);
+{
-}
+XSETCAR (tail, item);
-else if (counting == ending)
+}
-{
+else if (counting == ending)
-break;
+{
-}
+break;
 }
-++counting;
+}
-}
+++counting;
+}
+}
 if (counting < starting || (counting != ending && !NILP (end)))
 	{
 	  check_sequence_range (args[0], start, end, Flength (args[0]));
 	}
 {
 Ibyte *p2 = XSTRING_DATA (sequence2),
 *p2end = p2 + XSTRING_LENGTH (sequence2), *p2cursor;
 Charcount ii = 0, len1 = string_char_length (sequence1);
+check_sequence_range (sequence1, start1, end1, make_int (len1));
 while (ii < starting2 && p2 < p2end)
 {
 INC_IBYTEPTR (p2);
 ii++;
 }
 }
 return result;
 }
+DEFUN ("nsubstitute", Fnsubstitute, 3, MANY, 0, /*
+Substitute NEW for OLD in SEQUENCE.
+This is a destructive function; it reuses the storage of SEQUENCE whenever
+possible.  See `remove*' for the meaning of the keywords.
+arguments: (NEW OLD SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) FROM-END COUNT)
+*/
+(int nargs, Lisp_Object *args))
+{
+Lisp_Object new_ = args[0], item = args[1], sequence = args[2], tail = Qnil;
+Lisp_Object object_, position0;
+Elemcount starting = 0, ending = EMACS_INT_MAX, encountered = 0;
+Elemcount len, ii = 0, counting = EMACS_INT_MAX, presenting = 0;
+Boolint test_not_unboundp = 1;
+check_test_func_t check_test = NULL;
+struct gcpro gcpro1;
+PARSE_KEYWORDS (Fnsubstitute, nargs, args, 9,
+		  (test, if_, if_not, test_not, key, start, end, count,
+		   from_end), (start = Qzero));
+CHECK_SEQUENCE (sequence);
+CHECK_NATNUM (start);
+starting = BIGNUMP (start) ? 1 + EMACS_INT_MAX : XINT (start);
+if (!NILP (end))
+{
+CHECK_NATNUM (end);
+ending = BIGNUMP (end) ? 1 + EMACS_INT_MAX : XINT (end);
+}
+if (!NILP (count))
+{
+CHECK_INTEGER (count);
+if (INTP (count))
+{
+counting = XINT (count);
+}
+#ifdef HAVE_BIGNUM
+else
+{
+counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ?
+1 + EMACS_INT_MAX : -1 + EMACS_INT_MIN;
+}
+#endif
+if (counting <= 0)
+	{
+	  return sequence;
+	}
+}
+check_test = get_check_test_function (item, &test, test_not, if_, if_not,
+					key, &test_not_unboundp);
+if (CONSP (sequence))
+{
+Lisp_Object elt;
+if (!NILP (count) && !NILP (from_end))
+	{
+	  Lisp_Object present = count_with_tail (&elt, nargs - 1, args + 1,
+						 Qnsubstitute);
+	  if (ZEROP (present))
+	    {
+	      return sequence;
+	    }
+	  presenting = XINT (present);
+	  presenting = presenting <= counting ? 0 : presenting - counting;
+	}
+GCPRO1 (tail);
+{
+EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tail, len)
+{
+if (!(ii < ending))
+{
+break;
+}
+if (starting <= ii &&
+check_test (test, key, item, elt) == test_not_unboundp
+&& (presenting ? encountered++ >= presenting
+: encountered++ < counting))
+{
+CHECK_LISP_WRITEABLE (tail);
+XSETCAR (tail, new_);
+}
+else if (!presenting && encountered >= counting)
+{
+break;
+}
+ii++;
+}
+}
+UNGCPRO;
+if ((ii < starting || (ii < ending && !NILP (end)))
+	  && encountered < counting)
+	{
+	  check_sequence_range (args[0], start, end, Flength (args[0]));
+	}
+}
+else if (STRINGP (sequence))
+{
+Ibyte *staging, new_bytes[MAX_ICHAR_LEN], *staging_cursor;
+Ibyte *startp = XSTRING_DATA (sequence), *cursor = startp;
+Bytecount cursor_offset = 0, byte_len = XSTRING_LENGTH (sequence);
+Bytecount new_len;
+Lisp_Object character;
+CHECK_CHAR_COERCE_INT (new_);
+new_len = set_itext_ichar (new_bytes, XCHAR (new_));
+/* Worst case scenario; new char is four octets long, all the old ones
+	 were one octet long, all the old ones match.  */
+staging = alloca_ibytes (XSTRING_LENGTH (sequence) * new_len);
+staging_cursor = staging;
+if (!NILP (count) && !NILP (from_end))
+	{
+	  Lisp_Object present = count_with_tail (&character, nargs - 1,
+						 args + 1, Qnsubstitute);
+	  if (ZEROP (present))
+	    {
+	      return sequence;
+	    }
+	  presenting = XINT (present);
+	  /* If there are fewer items in the string than we have
+	     permission to change, we don't need to differentiate
+	     between the :from-end nil and :from-end t
+	     cases. Otherwise, presenting is the number of matching
+	     items we need to ignore before we start to change. */
+	  presenting = presenting <= counting ? 0 : presenting - counting;
+	}
+ii = 0;
+while (cursor_offset < byte_len && ii < ending)
+	{
+	  if (ii >= starting)
+	    {
+	      character = make_char (itext_ichar (cursor));
+	      if ((check_test (test, key, item, character)
+		   == test_not_unboundp)
+		  && (presenting ? encountered++ >= presenting :
+		      encountered++ < counting))
+		{
+		  staging_cursor
+		    += itext_copy_ichar (new_bytes, staging_cursor);
+		}
+	      else
+		{
+		  staging_cursor
+		    += itext_copy_ichar (cursor, staging_cursor);
+		}
+	      startp = XSTRING_DATA (sequence);
+	      cursor = startp + cursor_offset;
+	      if (byte_len != XSTRING_LENGTH (sequence)
+		  || !valid_ibyteptr_p (cursor))
+		{
+		  mapping_interaction_error (Qnsubstitute, sequence);
+		}
+	    }
+	  else
+	    {
+	      staging_cursor += itext_copy_ichar (cursor, staging_cursor);
+	    }
+	  INC_IBYTEPTR (cursor);
+	  cursor_offset = cursor - startp;
+	  ii++;
+	}
+if (ii < starting || (ii < ending && !NILP (end)))
+	{
+	  check_sequence_range (sequence, start, end, Flength (sequence));
+	}
+if (0 != encountered)
+	{
+	  CHECK_LISP_WRITEABLE (sequence);
+	  replace_string_range (sequence, Qzero, make_int (ii),
+				staging, staging_cursor);
+	}
+}
+else
+{
+Elemcount positioning;
+Lisp_Object object = Qnil;
+len = XINT (Flength (sequence));
+check_sequence_range (sequence, start, end, make_int (len));
+position0 = position (&object, item, sequence, check_test,
+test_not_unboundp, test, key, start, end, from_end,
+Qnil, Qnsubstitute);
+if (NILP (position0))
+	{
+	  return sequence;
+	}
+positioning = XINT (position0);
+ending = min (len, ending);
+Faset (sequence, position0, new_);
+encountered = 1;
+if (NILP (from_end))
+	{
+	  for (ii = positioning + 1; ii < ending; ii++)
+	    {
+	      object_ = Faref (sequence, make_int (ii));
+	      if (check_test (test, key, item, object_) == test_not_unboundp
+		  && encountered++ < counting)
+		{
+		  Faset (sequence, make_int (ii), new_);
+		}
+	      else if (encountered == counting)
+		{
+		  break;
+		}
+	    }
+	}
+else
+	{
+	  for (ii = positioning - 1; ii >= starting; ii--)
+	    {
+	      object_ = Faref (sequence, make_int (ii));
+	      if (check_test (test, key, item, object_) == test_not_unboundp
+		  && encountered++ < counting)
+		{
+		  Faset (sequence, make_int (ii), new_);
+		}
+	      else if (encountered == counting)
+		{
+		  break;
+		}
+	    }
+	}
+}
+return sequence;
+}
+DEFUN ("substitute", Fsubstitute, 3, MANY, 0, /*
+Substitute NEW for OLD in SEQUENCE.
+This is a non-destructive function; it makes a copy of SEQUENCE if necessary
+to avoid corrupting the original SEQUENCE.
+See `remove*' for the meaning of the keywords.
+arguments: (NEW OLD SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) COUNT)
+*/
+(int nargs, Lisp_Object *args))
+{
+Lisp_Object new_ = args[0], item = args[1], sequence = args[2], tail = Qnil;
+Lisp_Object elt, tailing = Qnil, result = Qnil, result_tail = Qnil;
+Lisp_Object object, position0, matched_count;
+Elemcount starting = 0, ending = EMACS_INT_MAX, encountered = 0;
+Elemcount len, ii = 0, counting = EMACS_INT_MAX, presenting = 0;
+Boolint test_not_unboundp = 1;
+check_test_func_t check_test = NULL;
+struct gcpro gcpro1;
+PARSE_KEYWORDS (Fsubstitute, nargs, args, 9,
+		  (test, if_, if_not, test_not, key, start, end, count,
+		   from_end), (start = Qzero, count = Qunbound));
+CHECK_SEQUENCE (sequence);
+CHECK_NATNUM (start);
+starting = BIGNUMP (start) ? 1 + EMACS_INT_MAX : XINT (start);
+if (!NILP (end))
+{
+CHECK_NATNUM (end);
+ending = BIGNUMP (end) ? 1 + EMACS_INT_MAX : XINT (end);
+}
+check_test = get_check_test_function (item, &test, test_not, if_, if_not,
+					key, &test_not_unboundp);
+if (!UNBOUNDP (count))
+{
+if (!NILP (count))
+	{
+CHECK_INTEGER (count);
+if (INTP (count))
+{
+counting = XINT (count);
+}
+#ifdef HAVE_BIGNUM
+else
+{
+counting = bignum_sign (XBIGNUM_DATA (count)) > 0 ?
+1 + EMACS_INT_MAX : -1 + EMACS_INT_MIN;
+}
+#endif
+if (counting <= 0)
+{
+return sequence;
+}
+	}
+}
+if (!CONSP (sequence))
+{
+position0 = position (&object, item, sequence, check_test,
+test_not_unboundp, test, key, start, end, from_end,
+Qnil, Qsubstitute);
+if (NILP (position0))
+	{
+	  return sequence;
+	}
+else
+	{
+	  args[2] = Fcopy_sequence (sequence);
+	  return Fnsubstitute (nargs, args);
+	}
+}
+matched_count = count_with_tail (&tail, nargs - 1, args + 1, Qsubstitute);
+if (ZEROP (matched_count))
+{
+return sequence;
+}
+if (!NILP (count) && !NILP (from_end))
+{
+presenting = XINT (matched_count);
+presenting = presenting <= counting ? 0 : presenting - counting;
+}
+GCPRO1 (tailing);
+{
+EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tailing, len)
+{
+if (EQ (tail, tailing))
+{
+if (NILP (result))
+{
+RETURN_UNGCPRO (XCDR (tail));
+}
+XSETCDR (result_tail, XCDR (tail));
+RETURN_UNGCPRO (result);
+}
+else if (starting <= ii && ii < ending &&
+(check_test (test, key, item, elt) == test_not_unboundp)
+&& (presenting ? encountered++ >= presenting
+: encountered++ < counting))
+{
+if (NILP (result))
+{
+result = result_tail = Fcons (new_, Qnil);
+}
+else
+{
+XSETCDR (result_tail, Fcons (new_, Qnil));
+result_tail = XCDR (result_tail);
+}
+}
+else if (NILP (result))
+{
+result = result_tail = Fcons (elt, Qnil);
+}
+else
+{
+XSETCDR (result_tail, Fcons (elt, Qnil));
+result_tail = XCDR (result_tail);
+}
+if (ii == ending)
+{
+break;
+}
+ii++;
+}
+}
+UNGCPRO;
+if (ii < starting || (ii < ending && !NILP (end)))
+{
+check_sequence_range (args[0], start, end, Flength (args[0]));
+}
+return result;
+}
+static Lisp_Object
+subst (Lisp_Object new_, Lisp_Object old, Lisp_Object tree, int depth)
+{
+if (depth + lisp_eval_depth > max_lisp_eval_depth)
+{
+stack_overflow ("Stack overflow in subst", tree);
+}
+if (EQ (tree, old))
+{
+return new_;
+}
+else if (CONSP (tree))
+{
+Lisp_Object aa = subst (new_, old, XCAR (tree), depth + 1);
+Lisp_Object dd = subst (new_, old, XCDR (tree), depth + 1);
+if (EQ (aa, XCAR (tree)) && EQ (dd, XCDR (tree)))
+	{
+	  return tree;
+	}
+else
+	{
+	  return Fcons (aa, dd);
+	}
+}
+else
+{
+return tree;
+}
+}
+static Lisp_Object
+sublis (Lisp_Object alist, Lisp_Object tree,
+	check_test_func_t check_test, Boolint test_not_unboundp,
+	Lisp_Object test, Lisp_Object key, int depth)
+{
+Lisp_Object keyed = KEY (key, tree), tailed = alist, aa, dd;
+struct gcpro gcpro1, gcpro2, gcpro3;
+if (depth + lisp_eval_depth > max_lisp_eval_depth)
+{
+stack_overflow ("Stack overflow in sublis", tree);
+}
+GCPRO3 (tailed, alist, tree);
+{
+EXTERNAL_ALIST_LOOP_5 (elt, elt_car, elt_cdr, alist, tail)
+{
+tailed = tail;
+if (check_test (test, key, elt_car, keyed) == test_not_unboundp)
+{
+/* Don't use elt_cdr, it is helpful to allow TEST or KEY to
+modify the alist while it executes. */
+RETURN_UNGCPRO (XCDR (elt));
+}
+}
+}
+if (!CONSP (tree))
+{
+RETURN_UNGCPRO (tree);
+}
+aa = sublis (alist, XCAR (tree), check_test, test_not_unboundp, test, key,
+	       depth + 1);
+dd = sublis (alist, XCDR (tree), check_test, test_not_unboundp, test, key,
+	       depth + 1);
+if (EQ (aa, XCAR (tree)) && EQ (dd, XCDR (tree)))
+{
+RETURN_UNGCPRO (tree);
+}
+RETURN_UNGCPRO (Fcons (aa, dd));
+}
+DEFUN ("sublis", Fsublis, 2, MANY, 0, /*
+Perform substitutions indicated by ALIST in TREE (non-destructively).
+Return a copy of TREE with all matching elements replaced.
+See `member*' for the meaning of :test, :test-not and :key.
+arguments: (ALIST TREE &key (TEST #'eql) (KEY #'identity) TEST-NOT)
+*/
+(int nargs, Lisp_Object *args))
+{
+Lisp_Object alist = args[0], tree = args[1];
+Boolint test_not_unboundp = 1;
+check_test_func_t check_test = NULL;
+PARSE_KEYWORDS (Fsublis, nargs, args, 5, (test, if_, test_not, if_not, key),
+		  (key = Qidentity));
+if (NILP (key))
+{
+key = Qidentity;
+}
+get_check_match_function (&test, test_not, if_, if_not,
+			    /* sublis() is going to apply the key, don't ask
+			       for a match function that will do it for
+			       us. */
+			    Qidentity, &test_not_unboundp, &check_test);
+if (CONSP (alist) && NILP (XCDR (alist)) && CONSP (XCAR (alist))
+&& EQ (key, Qidentity) && 1 == test_not_unboundp
+&& (check_eq_nokey == check_test ||
+	  (check_eql_nokey == check_test &&
+	   !NON_FIXNUM_NUMBER_P (XCAR (XCAR (alist))))))
+{
+/* #'subst with #'eq is very cheap indeed; call it. */
+return subst (XCDR (XCAR (alist)), XCAR (XCAR (alist)), tree, 0);
+}
+return sublis (alist, tree, check_test, test_not_unboundp, test, key, 0);
+}
+static Lisp_Object
+nsublis (Lisp_Object alist, Lisp_Object tree,
+	 check_test_func_t check_test,
+	 Boolint test_not_unboundp,
+	 Lisp_Object test, Lisp_Object key, int depth)
+{
+Lisp_Object tree_saved = tree, tailed = alist, tortoise = tree, keyed = Qnil;
+struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+int count = 0;
+if (depth + lisp_eval_depth > max_lisp_eval_depth)
+{
+stack_overflow ("Stack overflow in nsublis", tree);
+}
+GCPRO4 (tailed, alist, tree_saved, keyed);
+while (CONSP (tree))
+{
+Boolint replaced = 0;
+keyed = KEY (key, XCAR (tree));
+{
+	EXTERNAL_ALIST_LOOP_5 (elt, elt_car, elt_cdr, alist, tail)
+	  {
+	    tailed = tail;
+	    if (check_test (test, key, elt_car, keyed) == test_not_unboundp)
+	      {
+		CHECK_LISP_WRITEABLE (tree);
+		/* See comment in sublis() on using elt_cdr. */
+		XSETCAR (tree, XCDR (elt));
+		replaced = 1;
+		break;
+	      }
+	  }
+}
+if (!replaced)
+	{
+	  if (CONSP (XCAR (tree)))
+	    {
+	      nsublis (alist, XCAR (tree), check_test, test_not_unboundp,
+		       test, key, depth + 1);
+	    }
+	}
+keyed = KEY (key, XCDR (tree));
+replaced = 0;
+{
+	EXTERNAL_ALIST_LOOP_5 (elt, elt_car, elt_cdr, alist, tail)
+	  {
+	    tailed = tail;
+	    if (check_test (test, key, elt_car, keyed) == test_not_unboundp)
+	      {
+		CHECK_LISP_WRITEABLE (tree);
+		/* See comment in sublis() on using elt_cdr. */
+		XSETCDR (tree, XCDR (elt));
+		tree = Qnil;
+		break;
+	      }
+	  }
+}
+if (!NILP (tree))
+	{
+	  tree = XCDR (tree);
+	}
+if (++count > CIRCULAR_LIST_SUSPICION_LENGTH)
+	{
+	  if (count & 1)
+	    {
+	      tortoise = XCDR (tortoise);
+	    }
+	  if (EQ (tortoise, tree))
+	    {
+	      signal_circular_list_error (tree);
+	    }
+	}
+}
+RETURN_UNGCPRO (tree_saved);
+}
+DEFUN ("nsublis", Fnsublis, 2, MANY, 0, /*
+Perform substitutions indicated by ALIST in TREE (destructively).
+Any matching element of TREE is changed via a call to `setcar'.
+See `member*' for the meaning of :test, :test-not and :key.
+arguments: (ALIST TREE &key (TEST #'eql) (KEY #'identity) TEST-NOT)
+*/
+(int nargs, Lisp_Object *args))
+{
+Lisp_Object alist = args[0], tree = args[1], tailed = Qnil, keyed = Qnil;
+Boolint test_not_unboundp = 1;
+check_test_func_t check_test = NULL;
+struct gcpro gcpro1, gcpro2;
+PARSE_KEYWORDS (Fnsublis, nargs, args, 5, (test, if_, test_not, if_not, key),
+		  (key = Qidentity));
+if (NILP (key))
+{
+key = Qidentity;
+}
+get_check_match_function (&test, test_not, if_, if_not,
+			    /* nsublis() is going to apply the key, don't ask
+			       for a match function that will do it for
+			       us. */
+			    Qidentity, &test_not_unboundp, &check_test);
+GCPRO2 (tailed, keyed);
+keyed = KEY (key, tree);
+{
+/* nsublis() won't attempt to replace a cons handed to it, do that
+ourselves. */
+EXTERNAL_ALIST_LOOP_5 (elt, elt_car, elt_cdr, alist, tail)
+{
+tailed = tail;
+if (check_test (test, key, elt_car, keyed) == test_not_unboundp)
+{
+/* See comment in sublis() on using elt_cdr. */
+RETURN_UNGCPRO (XCDR (elt));
+}
+}
+}
+UNGCPRO;
+return nsublis (alist, tree, check_test, test_not_unboundp, test, key, 0);
+}
+DEFUN ("subst", Fsubst, 3, MANY, 0, /*
+Substitute NEW for OLD everywhere in TREE (non-destructively).
+Return a copy of TREE with all elements `eql' to OLD replaced by NEW.
+See `member*' for the meaning of :test, :test-not and :key.
+arguments: (NEW OLD TREE &key (TEST #'eql) (KEY #'identity) TEST-NOT)
+*/
+(int nargs, Lisp_Object *args))
+{
+Lisp_Object result, alist = noseeum_cons (noseeum_cons (args[1], args[0]),
+Qnil);
+args[1] = alist;
+result = Fsublis (nargs - 1, args + 1);
+free_cons (XCAR (alist));
+free_cons (alist);
+return result;
+}
+DEFUN ("nsubst", Fnsubst, 3, MANY, 0, /*
+Substitute NEW for OLD everywhere in TREE (destructively).
+Any element of TREE which is `eql' to OLD is changed to NEW (via a call to
+`setcar').
+See `member*' for the meaning of the keywords.
+arguments: (NEW OLD TREE &key (TEST #'eql) (KEY #'identity) TEST-NOT)
+*/
+(int nargs, Lisp_Object *args))
+{
+Lisp_Object result, alist = noseeum_cons (noseeum_cons (args[1], args[0]),
+Qnil);
+args[1] = alist;
+result = Fnsublis (nargs - 1, args + 1);
+free_cons (XCAR (alist));
+free_cons (alist);
+return result;
+}
+static Boolint
+tree_equal (Lisp_Object tree1, Lisp_Object tree2,
+	    check_test_func_t check_test, Boolint test_not_unboundp,
+	    Lisp_Object test, Lisp_Object key, int depth)
+{
+Lisp_Object tortoise1 = tree1, tortoise2 = tree2;
+struct gcpro gcpro1, gcpro2;
+int count = 0;
+Boolint result;
+if (depth + lisp_eval_depth > max_lisp_eval_depth)
+{
+stack_overflow ("Stack overflow in tree-equal", tree1);
+}
+GCPRO2 (tree1, tree2);
+while (CONSP (tree1) && CONSP (tree2)
+	 && tree_equal (XCAR (tree1), XCAR (tree2), check_test,
+			test_not_unboundp, test, key, depth + 1))
+{
+tree1 = XCDR (tree1);
+tree2 = XCDR (tree2);
+if (++count > CIRCULAR_LIST_SUSPICION_LENGTH)
+	{
+	  if (count & 1)
+	    {
+	      tortoise1 = XCDR (tortoise1);
+	      tortoise2 = XCDR (tortoise2);
+	    }
+	  if (EQ (tortoise1, tree1))
+	    {
+	      signal_circular_list_error (tree1);
+	    }
+	  if (EQ (tortoise2, tree2))
+	    {
+	      signal_circular_list_error (tree2);
+	    }
+	}
+}
+if (CONSP (tree1) || CONSP (tree2))
+{
+UNGCPRO;
+return 0;
+}
+result = check_test (test, key, tree1, tree2) == test_not_unboundp;
+UNGCPRO;
+return result;
+}
+DEFUN ("tree-equal", Ftree_equal, 2, MANY, 0, /*
+Return t if TREE1 and TREE2 have `eql' leaves.
+Atoms are compared by `eql', unless another test is specified using
+:test; cons cells are compared recursively.
+See `union' for the meaning of :test, :test-not and :key.
+arguments: (TREE1 TREE2 &key (TEST #'eql) (KEY #'identity) TEST-NOT)
+*/
+(int nargs, Lisp_Object *args))
+{
+Lisp_Object tree1 = args[0], tree2 = args[1];
+Boolint test_not_unboundp = 1;
+check_test_func_t check_test = NULL;
+PARSE_KEYWORDS (Ftree_equal, nargs, args, 3, (test, key, test_not),
+		  (key = Qidentity));
+get_check_match_function (&test, test_not, Qnil, Qnil, key,
+			    &test_not_unboundp, &check_test);
+return tree_equal (tree1, tree2, check_test, test_not_unboundp, test, key,
+		     0) ? Qt : Qnil;
+}
+static Lisp_Object
+mismatch_from_end (Lisp_Object sequence1, Lisp_Object start1, Lisp_Object end1,
+Lisp_Object sequence2, Lisp_Object start2, Lisp_Object end2,
+check_test_func_t check_match, Boolint test_not_unboundp,
+Lisp_Object test, Lisp_Object key,
+Boolint UNUSED (return_sequence1_index))
+{
+Elemcount sequence1_len = XINT (Flength (sequence1));
+Elemcount sequence2_len = XINT (Flength (sequence2)), ii = 0;
+Elemcount starting1, ending1, starting2, ending2;
+Lisp_Object *sequence1_storage = NULL, *sequence2_storage = NULL;
+struct gcpro gcpro1, gcpro2;
+check_sequence_range (sequence1, start1, end1, make_int (sequence1_len));
+starting1 = XINT (start1);
+ending1 = INTP (end1) ? XINT (end1) : 1 + EMACS_INT_MAX;
+ending1 = min (ending1, sequence1_len);
+check_sequence_range (sequence2, start2, end2, make_int (sequence2_len));
+starting2 = XINT (start2);
+ending2 = INTP (end2) ? XINT (end2) : 1 + EMACS_INT_MAX;
+ending2 = min (ending2, sequence2_len);
+if (LISTP (sequence1))
+{
+Lisp_Object *saving;
+sequence1_storage = saving
+= alloca_array (Lisp_Object, ending1 - starting1);
+{
+EXTERNAL_LIST_LOOP_2 (elt, sequence1)
+{
+if (starting1 <= ii && ii < ending1)
+{
+*saving++ = elt;
+}
+else if (ii == ending1)
+{
+break;
+}
+++ii;
+}
+}
+}
+else if (STRINGP (sequence1))
+{
+const Ibyte *cursor = string_char_addr (sequence1, starting1);
+STRING_DATA_TO_OBJECT_ARRAY (cursor, sequence1_storage, ii,
+ending1 - starting1);
+}
+else if (BIT_VECTORP (sequence1))
+{
+Lisp_Bit_Vector *vv = XBIT_VECTOR (sequence1);
+sequence1_storage = alloca_array (Lisp_Object, ending1 - starting1);
+for (ii = starting1; ii < ending1; ++ii)
+{
+sequence1_storage[ii - starting1]
+= make_int (bit_vector_bit (vv, ii));
+}
+}
+else
+{
+sequence1_storage = XVECTOR_DATA (sequence1) + starting1;
+}
+ii = 0;
+if (LISTP (sequence2))
+{
+Lisp_Object *saving;
+sequence2_storage = saving
+= alloca_array (Lisp_Object, ending2 - starting2);
+{
+EXTERNAL_LIST_LOOP_2 (elt, sequence2)
+{
+if (starting2 <= ii && ii < ending2)
+{
+*saving++ = elt;
+}
+else if (ii == ending2)
+{
+break;
+}
+++ii;
+}
+}
+}
+else if (STRINGP (sequence2))
+{
+const Ibyte *cursor = string_char_addr (sequence2, starting2);
+STRING_DATA_TO_OBJECT_ARRAY (cursor, sequence2_storage, ii,
+ending2 - starting2);
+}
+else if (BIT_VECTORP (sequence2))
+{
+Lisp_Bit_Vector *vv = XBIT_VECTOR (sequence2);
+sequence2_storage = alloca_array (Lisp_Object, ending2 - starting2);
+for (ii = starting2; ii < ending2; ++ii)
+{
+sequence2_storage[ii - starting2]
+= make_int (bit_vector_bit (vv, ii));
+}
+}
+else
+{
+sequence2_storage = XVECTOR_DATA (sequence2) + starting2;
+}
+GCPRO2 (sequence1_storage[0], sequence2_storage[0]);
+gcpro1.nvars = ending1 - starting1;
+gcpro2.nvars = ending2 - starting2;
+while (ending1 > starting1 && ending2 > starting2)
+{
+--ending1;
+--ending2;
+if (check_match (test, key, sequence1_storage[ending1 - starting1],
+sequence2_storage[ending2 - starting2])
+!= test_not_unboundp)
+{
+UNGCPRO;
+return make_integer (ending1 + 1);
+}
+}
+UNGCPRO;
+if (ending1 > starting1 || ending2 > starting2)
+{
+return make_integer (ending1);
+}
+return Qnil;
+}
+static Lisp_Object
+mismatch_list_list (Lisp_Object sequence1, Lisp_Object start1, Lisp_Object end1,
+Lisp_Object sequence2, Lisp_Object start2, Lisp_Object end2,
+check_test_func_t check_match, Boolint test_not_unboundp,
+Lisp_Object test, Lisp_Object key,
+Boolint UNUSED (return_list_index))
+{
+Lisp_Object sequence1_tortoise = sequence1, sequence2_tortoise = sequence2;
+Lisp_Object orig_sequence1 = sequence1, orig_sequence2 = sequence2;
+Elemcount ending1 = EMACS_INT_MAX, ending2 = EMACS_INT_MAX;
+Elemcount starting1, starting2, counting, startcounting;
+Elemcount shortest_len = 0;
+struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+starting1 = INTP (start1) ? XINT (start1) : 1 + EMACS_INT_MAX;
+starting2 = INTP (start2) ? XINT (start2) : 1 + EMACS_INT_MAX;
+if (!NILP (end1))
+{
+ending1 = INTP (end1) ? XINT (end1) : 1 + EMACS_INT_MAX;
+}
+if (!NILP (end2))
+{
+ending2 = INTP (end2) ? XINT (end2) : 1 + EMACS_INT_MAX;
+}
+if (!ZEROP (start1))
+{
+sequence1 = Fnthcdr (start1, sequence1);
+if (NILP (sequence1))
+{
+check_sequence_range (sequence1_tortoise, start1, end1,
+Flength (sequence1_tortoise));
+/* Give up early here. */
+return Qnil;
+}
+ending1 -= starting1;
+starting1 = 0;
+sequence1_tortoise = sequence1;
+}
+if (!ZEROP (start2))
+{
+sequence2 = Fnthcdr (start2, sequence2);
+if (NILP (sequence2))
+{
+check_sequence_range (sequence2_tortoise, start2, end2,
+Flength (sequence2_tortoise));
+return Qnil;
+}
+ending2 -= starting2;
+starting2 = 0;
+sequence2_tortoise = sequence2;
+}
+GCPRO4 (sequence1, sequence2, sequence1_tortoise, sequence2_tortoise);
+counting = startcounting = min (ending1, ending2);
+while (counting-- > 0 && !NILP (sequence1) && !NILP (sequence2))
+{
+if (check_match (test, key,
+CONSP (sequence1) ? XCAR (sequence1)
+: Fcar (sequence1),
+CONSP (sequence2) ? XCAR (sequence2)
+: Fcar (sequence2) ) != test_not_unboundp)
+{
+UNGCPRO;
+return make_integer (XINT (start1) + shortest_len);
+}
+sequence1 = CONSP (sequence1) ? XCDR (sequence1) : Fcdr (sequence1);
+sequence2 = CONSP (sequence2) ? XCDR (sequence2) : Fcdr (sequence2);
+shortest_len++;
+if (startcounting - counting > CIRCULAR_LIST_SUSPICION_LENGTH)
+{
+if (counting & 1)
+{
+sequence1_tortoise = XCDR (sequence1_tortoise);
+sequence2_tortoise = XCDR (sequence2_tortoise);
+}
+if (EQ (sequence1, sequence1_tortoise))
+{
+signal_circular_list_error (sequence1);
+}
+if (EQ (sequence2, sequence2_tortoise))
+{
+signal_circular_list_error (sequence2);
+}
+}
+}
+UNGCPRO;
+if (NILP (sequence1))
+{
+Lisp_Object args[] = { start1, make_int (shortest_len) };
+check_sequence_range (orig_sequence1, start1, end1,
+Fplus (countof (args), args));
+}
+if (NILP (sequence2))
+{
+Lisp_Object args[] = { start2, make_int (shortest_len) };
+check_sequence_range (orig_sequence2, start2, end2,
+Fplus (countof (args), args));
+}
+if ((!NILP (end1) && shortest_len != ending1 - starting1) ||
+(!NILP (end2) && shortest_len != ending2 - starting2))
+{
+return make_integer (XINT (start1) + shortest_len);
+}
+if ((NILP (end1) && CONSP (sequence1)) || (NILP (end2) && CONSP (sequence2)))
+{
+return make_integer (XINT (start1) + shortest_len);
+}
+return Qnil;
+}
+static Lisp_Object
+mismatch_list_string (Lisp_Object list, Lisp_Object list_start,
+Lisp_Object list_end,
+Lisp_Object string, Lisp_Object string_start,
+Lisp_Object string_end,
+check_test_func_t check_match,
+Boolint test_not_unboundp,
+Lisp_Object test, Lisp_Object key,
+Boolint return_list_index)
+{
+Ibyte *string_data = XSTRING_DATA (string), *startp = string_data;
+Bytecount string_offset = 0, string_len = XSTRING_LENGTH (string);
+Elemcount char_count = 0, list_starting, list_ending;
+Elemcount string_starting, string_ending;
+Lisp_Object character, orig_list = list;
+struct gcpro gcpro1;
+list_ending = INTP (list_end) ? XINT (list_end) : 1 + EMACS_INT_MAX;
+list_starting = INTP (list_start) ? XINT (list_start) : 1 + EMACS_INT_MAX;
+string_ending = INTP (string_end) ? XINT (string_end) : 1 + EMACS_INT_MAX;
+string_starting
+= INTP (string_start) ? XINT (string_start) : 1 + EMACS_INT_MAX;
+while (char_count < string_starting && string_offset < string_len)
+{
+INC_IBYTEPTR (string_data);
+string_offset = string_data - startp;
+char_count++;
+}
+if (!ZEROP (list_start))
+{
+list = Fnthcdr (list_start, list);
+if (NILP (list))
+{
+check_sequence_range (orig_list, list_start, list_end,
+Flength (orig_list));
+return Qnil;
+}
+list_ending -= list_starting;
+list_starting = 0;
+}
+GCPRO1 (list);
+while (list_starting < list_ending && string_starting < string_ending
+&& string_offset < string_len && !NILP (list))
+{
+character = make_char (itext_ichar (string_data));
+if (return_list_index)
+{
+if (check_match (test, key, CONSP (list) ? XCAR (list) : Fcar (list),
+character)
+!= test_not_unboundp)
+{
+UNGCPRO;
+return make_integer (XINT (list_start) + char_count);
+}
+}
+else
+{
+if (check_match (test, key, character,
+CONSP (list) ? XCAR (list) : Fcar (list))
+!= test_not_unboundp)
+{
+UNGCPRO;
+return make_integer (char_count);
+}
+}
+list = CONSP (list) ? XCDR (list) : Fcdr (list);
+startp = XSTRING_DATA (string);
+string_data = startp + string_offset;
+if (string_len != XSTRING_LENGTH (string)
+|| !valid_ibyteptr_p (string_data))
+{
+mapping_interaction_error (Qmismatch, string);
+}
+list_starting++;
+string_starting++;
+char_count++;
+INC_IBYTEPTR (string_data);
+string_offset = string_data - startp;
+}
+UNGCPRO;
+if (NILP (list))
+{
+Lisp_Object args[] = { list_start, make_int (char_count) };
+check_sequence_range (orig_list, list_start, list_end,
+Fplus (countof (args), args));
+}
+if (string_data == XSTRING_DATA (string) + XSTRING_LENGTH (string))
+{
+check_sequence_range (string, string_start, string_end,
+make_int (char_count));
+}
+if ((NILP (string_end) ?
+string_offset < string_len : string_starting < string_ending) ||
+(NILP (list_end) ? !NILP (list) : list_starting < list_ending))
+{
+return make_integer (return_list_index ? XINT (list_start) + char_count :
+char_count);
+}
+return Qnil;
+}
+static Lisp_Object
+mismatch_list_array (Lisp_Object list, Lisp_Object list_start,
+Lisp_Object list_end,
+Lisp_Object array, Lisp_Object array_start,
+Lisp_Object array_end,
+check_test_func_t check_match,
+Boolint test_not_unboundp,
+Lisp_Object test, Lisp_Object key,
+Boolint return_list_index)
+{
+Elemcount ii = 0, list_starting, list_ending;
+Elemcount array_starting, array_ending, array_len;
+Lisp_Object orig_list = list;
+struct gcpro gcpro1;
+list_ending = INTP (list_end) ? XINT (list_end) : 1 + EMACS_INT_MAX;
+list_starting = INTP (list_start) ? XINT (list_start) : 1 + EMACS_INT_MAX;
+array_ending = INTP (array_end) ? XINT (array_end) : 1 + EMACS_INT_MAX;
+array_starting = INTP (array_start) ? XINT (array_start) : 1 + EMACS_INT_MAX;
+array_len = XINT (Flength (array));
+array_ending = min (array_ending, array_len);
+check_sequence_range (array, array_start, array_end, make_int (array_len));
+if (!ZEROP (list_start))
+{
+list = Fnthcdr (list_start, list);
+if (NILP (list))
+{
+check_sequence_range (orig_list, list_start, list_end,
+Flength (orig_list));
+return Qnil;
+}
+list_ending -= list_starting;
+list_starting = 0;
+}
+GCPRO1 (list);
+while (list_starting < list_ending && array_starting < array_ending
+&& !NILP (list))
+{
+if (return_list_index)
+{
+if (check_match (test, key, CONSP (list) ? XCAR (list) : Fcar (list),
+Faref (array, make_int (array_starting)))
+!= test_not_unboundp)
+{
+UNGCPRO;
+return make_integer (XINT (list_start) + ii);
+}
+}
+else
+{
+if (check_match (test, key, Faref (array, make_int (array_starting)),
+CONSP (list) ? XCAR (list) : Fcar (list))
+!= test_not_unboundp)
+{
+UNGCPRO;
+return make_integer (array_starting);
+}
+}
+list = CONSP (list) ? XCDR (list) : Fcdr (list);
+list_starting++;
+array_starting++;
+ii++;
+}
+UNGCPRO;
+if (NILP (list))
+{
+Lisp_Object args[] = { list_start, make_int (ii) };
+check_sequence_range (orig_list, list_start, list_end,
+Fplus (countof (args), args));
+}
+if (array_starting < array_ending ||
+(NILP (list_end) ? !NILP (list) : list_starting < list_ending))
+{
+return make_integer (return_list_index ? XINT (list_start) + ii :
+array_starting);
+}
+return Qnil;
+}
+static Lisp_Object
+mismatch_string_array (Lisp_Object string, Lisp_Object string_start,
+Lisp_Object string_end,
+Lisp_Object array, Lisp_Object array_start,
+Lisp_Object array_end,
+check_test_func_t check_match, Boolint test_not_unboundp,
+Lisp_Object test, Lisp_Object key,
+Boolint return_string_index)
+{
+Ibyte *string_data = XSTRING_DATA (string), *startp = string_data;
+Bytecount string_offset = 0, string_len = XSTRING_LENGTH (string);
+Elemcount char_count = 0, array_starting, array_ending, array_length;
+Elemcount string_starting, string_ending;
+Lisp_Object character;
+array_starting = INTP (array_start) ? XINT (array_start) : 1 + EMACS_INT_MAX;
+array_ending = INTP (array_end) ? XINT (array_end) : 1 + EMACS_INT_MAX;
+array_length = XINT (Flength (array));
+check_sequence_range (array, array_start, array_end, make_int (array_length));
+array_ending = min (array_ending, array_length);
+string_ending = INTP (string_end) ? XINT (string_end) : 1 + EMACS_INT_MAX;
+string_starting
+= INTP (string_start) ? XINT (string_start) : 1 + EMACS_INT_MAX;
+while (char_count < string_starting && string_offset < string_len)
+{
+INC_IBYTEPTR (string_data);
+string_offset = string_data - startp;
+char_count++;
+}
+while (array_starting < array_ending && string_starting < string_ending
+&& string_offset < string_len)
+{
+character = make_char (itext_ichar (string_data));
+if (return_string_index)
+{
+if (check_match (test, key, character,
+Faref (array, make_int (array_starting)))
+!= test_not_unboundp)
+{
+return make_integer (char_count);
+}
+}
+else
+{
+if (check_match (test, key,
+Faref (array, make_int (array_starting)),
+character)
+!= test_not_unboundp)
+{
+return make_integer (XINT (array_start) + char_count);
+}
+}
+startp = XSTRING_DATA (string);
+string_data = startp + string_offset;
+if (string_len != XSTRING_LENGTH (string)
+|| !valid_ibyteptr_p (string_data))
+{
+mapping_interaction_error (Qmismatch, string);
+}
+array_starting++;
+string_starting++;
+char_count++;
+INC_IBYTEPTR (string_data);
+string_offset = string_data - startp;
+}
+if (string_data == XSTRING_DATA (string) + XSTRING_LENGTH (string))
+{
+check_sequence_range (string, string_start, string_end,
+make_int (char_count));
+}
+if ((NILP (string_end) ?
+string_offset < string_len : string_starting < string_ending) ||
+(NILP (array_end) ? !NILP (array) : array_starting < array_ending))
+{
+return make_integer (return_string_index ? char_count :
+XINT (array_start) + char_count);
+}
+return Qnil;
+}
+static Lisp_Object
+mismatch_string_string (Lisp_Object string1,
+Lisp_Object string1_start, Lisp_Object string1_end,
+Lisp_Object string2, Lisp_Object string2_start,
+Lisp_Object string2_end,
+check_test_func_t check_match,
+Boolint test_not_unboundp,
+Lisp_Object test, Lisp_Object key,
+Boolint UNUSED (return_string1_index))
+{
+Ibyte *string1_data = XSTRING_DATA (string1), *startp1 = string1_data;
+Bytecount string1_offset = 0, string1_len = XSTRING_LENGTH (string1);
+Ibyte *string2_data = XSTRING_DATA (string2), *startp2 = string2_data;
+Bytecount string2_offset = 0, string2_len = XSTRING_LENGTH (string2);
+Elemcount char_count1 = 0, string1_starting, string1_ending;
+Elemcount char_count2 = 0, string2_starting, string2_ending;
+Lisp_Object character1, character2;
+string1_ending = INTP (string1_end) ? XINT (string1_end) : 1 + EMACS_INT_MAX;
+string1_starting
+= INTP (string1_start) ? XINT (string1_start) : 1 + EMACS_INT_MAX;
+string2_starting
+= INTP (string2_start) ? XINT (string2_start) : 1 + EMACS_INT_MAX;
+string2_ending = INTP (string2_end) ? XINT (string2_end) : 1 + EMACS_INT_MAX;
+while (char_count1 < string1_starting && string1_offset < string1_len)
+{
+INC_IBYTEPTR (string1_data);
+string1_offset = string1_data - startp1;
+char_count1++;
+}
+while (char_count2 < string2_starting && string2_offset < string2_len)
+{
+INC_IBYTEPTR (string2_data);
+string2_offset = string2_data - startp2;
+char_count2++;
+}
+while (string2_starting < string2_ending && string1_starting < string1_ending
+&& string1_offset < string1_len && string2_offset < string2_len)
+{
+character1 = make_char (itext_ichar (string1_data));
+character2 = make_char (itext_ichar (string2_data));
+if (check_match (test, key, character1, character2)
+!= test_not_unboundp)
+{
+return make_integer (char_count1);
+}
+startp1 = XSTRING_DATA (string1);
+string1_data = startp1 + string1_offset;
+if (string1_len != XSTRING_LENGTH (string1)
+|| !valid_ibyteptr_p (string1_data))
+{
+mapping_interaction_error (Qmismatch, string1);
+}
+startp2 = XSTRING_DATA (string2);
+string2_data = startp2 + string2_offset;
+if (string2_len != XSTRING_LENGTH (string2)
+|| !valid_ibyteptr_p (string2_data))
+{
+mapping_interaction_error (Qmismatch, string2);
+}
+string2_starting++;
+string1_starting++;
+char_count1++;
+char_count2++;
+INC_IBYTEPTR (string1_data);
+string1_offset = string1_data - startp1;
+INC_IBYTEPTR (string2_data);
+string2_offset = string2_data - startp2;
+}
+if (string1_data == XSTRING_DATA (string1) + XSTRING_LENGTH (string1))
+{
+check_sequence_range (string1, string1_start, string1_end,
+make_int (char_count1));
+}
+if (string2_data == XSTRING_DATA (string2) + XSTRING_LENGTH (string2))
+{
+check_sequence_range (string2, string2_start, string2_end,
+make_int (char_count2));
+}
+if ((!NILP (string1_end) && string1_starting < string1_ending) ||
+(!NILP (string2_end) && string2_starting < string2_ending))
+{
+return make_integer (char_count1);
+}
+if ((NILP (string1_end) && string1_data
+< (XSTRING_DATA (string1) + XSTRING_LENGTH (string1))) ||
+(NILP (string2_end) && string2_data
+< (XSTRING_DATA (string2) + XSTRING_LENGTH (string2))))
+{
+return make_integer (char_count1);
+}
+return Qnil;
+}
+static Lisp_Object
+mismatch_array_array (Lisp_Object array1, Lisp_Object start1, Lisp_Object end1,
+Lisp_Object array2, Lisp_Object start2, Lisp_Object end2,
+check_test_func_t check_match, Boolint test_not_unboundp,
+Lisp_Object test, Lisp_Object key,
+Boolint UNUSED (return_array1_index))
+{
+Elemcount len1 = XINT (Flength (array1)), len2 = XINT (Flength (array2));
+Elemcount ending1 = EMACS_INT_MAX, ending2 = EMACS_INT_MAX;
+Elemcount starting1, starting2;
+check_sequence_range (array1, start1, end1, make_int (len1));
+check_sequence_range (array2, start2, end2, make_int (len2));
+starting1 = INTP (start1) ? XINT (start1) : 1 + EMACS_INT_MAX;
+starting2 = INTP (start2) ? XINT (start2) : 1 + EMACS_INT_MAX;
+if (!NILP (end1))
+{
+ending1 = INTP (end1) ? XINT (end1) : 1 + EMACS_INT_MAX;
+}
+if (!NILP (end2))
+{
+ending2 = INTP (end2) ? XINT (end2) : 1 + EMACS_INT_MAX;
+}
+ending1 = min (ending1, len1);
+ending2 = min (ending2, len2);
+while (starting1 < ending1 && starting2 < ending2)
+{
+if (check_match (test, key, Faref (array1, make_int (starting1)),
+Faref (array2, make_int (starting2)))
+!= test_not_unboundp)
+{
+return make_integer (starting1);
+}
+starting1++;
+starting2++;
+}
+if (starting1 < ending1 || starting2 < ending2)
+{
+return make_integer (starting1);
+}
+return Qnil;
+}
+typedef Lisp_Object
+(*mismatch_func_t) (Lisp_Object sequence1, Lisp_Object start1, Lisp_Object end1,
+Lisp_Object sequence2, Lisp_Object start2, Lisp_Object end2,
+check_test_func_t check_match, Boolint test_not_unboundp,
+Lisp_Object test, Lisp_Object key,
+Boolint return_list_index);
+static mismatch_func_t
+get_mismatch_func (Lisp_Object sequence1, Lisp_Object sequence2,
+Lisp_Object from_end, Boolint *return_sequence1_index_out)
+{
+CHECK_SEQUENCE (sequence1);
+CHECK_SEQUENCE (sequence2);
+if (!NILP (from_end))
+{
+*return_sequence1_index_out = 1;
+return mismatch_from_end;
+}
+if (LISTP (sequence1))
+{
+if (LISTP (sequence2))
+{
+*return_sequence1_index_out = 1;
+return mismatch_list_list;
+}
+if (STRINGP (sequence2))
+{
+*return_sequence1_index_out = 1;
+return mismatch_list_string;
+}
+*return_sequence1_index_out = 1;
+return mismatch_list_array;
+}
+if (STRINGP (sequence1))
+{
+if (STRINGP (sequence2))
+{
+*return_sequence1_index_out = 1;
+return mismatch_string_string;
+}
+if (LISTP (sequence2))
+{
+*return_sequence1_index_out = 0;
+return mismatch_list_string;
+}
+*return_sequence1_index_out = 1;
+return mismatch_string_array;
+}
+if (ARRAYP (sequence1))
+{
+if (STRINGP (sequence2))
+{
+*return_sequence1_index_out = 0;
+return mismatch_string_array;
+}
+if (LISTP (sequence2))
+{
+*return_sequence1_index_out = 0;
+return mismatch_list_array;
+}
+*return_sequence1_index_out = 1;
+return mismatch_array_array;
+}
+RETURN_NOT_REACHED (NULL);
+return NULL;
+}
+DEFUN ("mismatch", Fmismatch, 2, MANY, 0, /*
+Compare SEQUENCE1 with SEQUENCE2, return index of first mismatching element.
+Return nil if the sequences match.  If one sequence is a prefix of the
+other, the return value indicates the end of the shorter sequence.  A
+non-nil return value always reflects an index into SEQUENCE1.
+See `search' for the meaning of the keywords."
+arguments: (SEQUENCE1 SEQUENCE2 &key (TEST #'eql) (KEY #'identity) (START1 0) END1 (START2 0) END2 FROM-END TEST-NOT)
+*/
+(int nargs, Lisp_Object *args))
+{
+Lisp_Object sequence1 = args[0], sequence2 = args[1];
+Boolint test_not_unboundp = 1, return_first_index = 0;
+check_test_func_t check_match = NULL;
+mismatch_func_t mismatch = NULL;
+PARSE_KEYWORDS (Fmismatch, nargs, args, 8,
+(test, key, from_end, start1, end1, start2, end2, test_not),
+(start1 = start2 = Qzero));
+CHECK_SEQUENCE (sequence1);
+CHECK_SEQUENCE (sequence2);
+CHECK_NATNUM (start1);
+CHECK_NATNUM (start2);
+if (!NILP (end1))
+{
+CHECK_NATNUM (end1);
+}
+if (!NILP (end2))
+{
+CHECK_NATNUM (end2);
+}
+check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key,
+&test_not_unboundp, NULL);
+mismatch = get_mismatch_func (sequence1, sequence2, from_end,
+&return_first_index);
+if (return_first_index)
+{
+return mismatch (sequence1, start1, end1, sequence2, start2, end2,
+check_match, test_not_unboundp, test, key, 1);
+}
+return mismatch (sequence2, start2, end2, sequence1, start1, end1,
+check_match, test_not_unboundp, test, key, 0);
+}
+DEFUN ("search", Fsearch, 2, MANY, 0, /*
+Search for SEQUENCE1 as a subsequence of SEQUENCE2.
+Return the index of the leftmost element of the first match found; return
+nil if there are no matches.
+In this function, :start1 and :end1 specify a subsequence of SEQUENCE1, and
+:start2 and :end2 specify a subsequence of SEQUENCE2.  See `remove*' for
+details of the other keywords.
+arguments: (SEQUENCE1 SEQUENCE2 &key (TEST #'eql) (KEY #'identity) (START1 0) END1 (START2 0) END2 FROM-END TEST-NOT)
+*/
+(int nargs, Lisp_Object *args))
+{
+Lisp_Object sequence1 = args[0], sequence2 = args[1], position0 = Qnil;
+Boolint test_not_unboundp = 1, return_first = 0;
+check_test_func_t check_test = NULL, check_match = NULL;
+mismatch_func_t mismatch = NULL;
+Elemcount starting1 = 0, ending1 = 1 + EMACS_INT_MAX, starting2 = 0;
+Elemcount ending2 = 1 + EMACS_INT_MAX, ii = 0;
+Elemcount length1;
+Lisp_Object object = Qnil;
+struct gcpro gcpro1, gcpro2;
+PARSE_KEYWORDS (Fsearch, nargs, args, 8,
+(test, key, from_end, start1, end1, start2, end2, test_not),
+(start1 = start2 = Qzero));
+CHECK_SEQUENCE (sequence1);
+CHECK_SEQUENCE (sequence2);
+CHECK_KEY_ARGUMENT (key);
+CHECK_NATNUM (start1);
+starting1 = INTP (start1) ? XINT (start1) : 1 + EMACS_INT_MAX;
+CHECK_NATNUM (start2);
+starting2 = INTP (start2) ? XINT (start2) : 1 + EMACS_INT_MAX;
+if (!NILP (end1))
+{
+Lisp_Object len1 = Flength (sequence1);
+CHECK_NATNUM (end1);
+check_sequence_range (sequence1, start1, end1, len1);
+ending1 = min (XINT (end1), XINT (len1));
+}
+else
+{
+end1 = Flength (sequence1);
+check_sequence_range (sequence1, start1, end1, end1);
+ending1 = XINT (end1);
+}
+length1 = ending1 - starting1;
+if (!NILP (end2))
+{
+Lisp_Object len2 = Flength (sequence2);
+CHECK_NATNUM (end2);
+check_sequence_range (sequence2, start2, end2, len2);
+ending2 = min (XINT (end2), XINT (len2));
+}
+else
+{
+end2 = Flength (sequence2);
+check_sequence_range (sequence2, start2, end2, end2);
+ending2 = XINT (end2);
+}
+check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key,
+&test_not_unboundp, &check_test);
+mismatch = get_mismatch_func (sequence1, sequence2, from_end, &return_first);
+if (bytecode_arithcompare (start1, make_integer (ending1)) >= 0)
+{
+if (NILP (from_end))
+{
+return start2;
+}
+if (NILP (end2))
+{
+return Flength (sequence2);
+}
+return end2;
+}
+if (NILP (from_end))
+{
+Lisp_Object mismatch_start1 = Fadd1 (start1);
+Lisp_Object first = KEY (key, Felt (sequence1, start1));
+GCPRO2 (first, mismatch_start1);
+ii = starting2;
+while (ii < ending2)
+{
+position0 = position (&object, first, sequence2, check_test,
+test_not_unboundp, test, key, make_int (ii),
+end2, Qnil, Qnil, Qsearch);
+if (NILP (position0))
+{
+UNGCPRO;
+return Qnil;
+}
+if (length1 + XINT (position0) <= ending2 &&
+(return_first ?
+NILP (mismatch (sequence1, mismatch_start1, end1,
+sequence2,
+make_int (1 + XINT (position0)),
+make_int (length1 + XINT (position0)),
+check_match, test_not_unboundp, test, key, 1)) :
+NILP (mismatch (sequence2,
+make_int (1 + XINT (position0)),
+make_int (length1 + XINT (position0)),
+sequence1, mismatch_start1, end1,
+check_match, test_not_unboundp, test, key, 0))))
+{
+UNGCPRO;
+return position0;
+}
+ii = XINT (position0) + 1;
+}
+UNGCPRO;
+}
+else
+{
+Lisp_Object mismatch_end1 = make_integer (ending1 - 1);
+Lisp_Object last = KEY (key, Felt (sequence1, mismatch_end1));
+GCPRO2 (last, mismatch_end1);
+ii = ending2;
+while (ii > starting2)
+{
+position0 = position (&object, last, sequence2, check_test,
+test_not_unboundp, test, key, start2,
+make_int (ii), Qt, Qnil, Qsearch);
+if (NILP (position0))
+{
+UNGCPRO;
+return Qnil;
+}
+if (XINT (position0) - length1 + 1 >= starting2 &&
+(return_first ?
+NILP (mismatch (sequence1, start1, mismatch_end1,
+sequence2,
+make_int (XINT (position0) - length1 + 1),
+make_int (XINT (position0)),
+check_match, test_not_unboundp, test, key, 1)) :
+NILP (mismatch (sequence2,
+make_int (XINT (position0) - length1 + 1),
+make_int (XINT (position0)),
+sequence1, start1, mismatch_end1,
+check_match, test_not_unboundp, test, key, 0))))
+{
+UNGCPRO;
+return make_int (XINT (position0) - length1 + 1);
+}
+ii = XINT (position0);
+}
+UNGCPRO;
+}
+return Qnil;
+}
+/* These two functions do set operations, those that can be visualised with
+Venn diagrams. */
+static Lisp_Object
+venn (Lisp_Object caller, int nargs, Lisp_Object *args, Boolint intersectionp)
+{
+Lisp_Object liszt1 = args[0], liszt2 = args[1], elt = Qnil, tail = Qnil;
+Lisp_Object result = EQ (caller, Qsubsetp) ? Qt : Qnil, result_tail = Qnil;
+Lisp_Object keyed = Qnil, ignore = Qnil;
+Elemcount len;
+Boolint test_not_unboundp = 1;
+check_test_func_t check_test = NULL;
+struct gcpro gcpro1, gcpro2, gcpro3;
+PARSE_KEYWORDS_8 (caller, nargs, args, 4, (test, key, test_not, stable),
+NULL, 2, 0);
+CHECK_LIST (liszt1);
+CHECK_LIST (liszt2);
+CHECK_KEY_ARGUMENT (key);
+if (NILP (liszt1) && intersectionp)
+{
+return Qnil;
+}
+if (NILP (liszt2))
+{
+return intersectionp ? Qnil : liszt1;
+}
+get_check_match_function (&test, test_not, Qnil, Qnil, key,
+&test_not_unboundp, &check_test);
+GCPRO3 (tail, keyed, result);
+{
+EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, liszt1, tail, len)
+{
+keyed = KEY (key, elt);
+if (NILP (list_position_cons_before (&ignore, keyed, liszt2,
+check_test, test_not_unboundp,
+test, key, 0, Qzero, Qnil))
+!= intersectionp)
+{
+if (EQ (Qsubsetp, caller))
+{
+result = Qnil;
+break;
+}
+else if (NILP (stable))
+{
+result = Fcons (elt, result);
+}
+else if (NILP (result))
+{
+result = result_tail = Fcons (elt, Qnil);
+}
+else
+{
+XSETCDR (result_tail, Fcons (elt, Qnil));
+result_tail = XCDR (result_tail);
+}
+}
+}
+}
+UNGCPRO;
+return result;
+}
+static Lisp_Object
+nvenn (Lisp_Object caller, int nargs, Lisp_Object *args, Boolint intersectionp)
+{
+Lisp_Object liszt1 = args[0], liszt2 = args[1], tortoise_elt, ignore = Qnil;
+Lisp_Object elt = Qnil, tail = Qnil, keyed = Qnil, prev_tail = Qnil;
+Elemcount count;
+Boolint test_not_unboundp = 1;
+check_test_func_t check_test = NULL;
+struct gcpro gcpro1, gcpro2, gcpro3;
+PARSE_KEYWORDS_8 (caller, nargs, args, 3, (test, key, test_not),
+NULL, 2, 0);
+CHECK_LIST (liszt1);
+CHECK_LIST (liszt2);
+CHECK_KEY_ARGUMENT (key);
+if (NILP (liszt1) && intersectionp)
+{
+return Qnil;
+}
+if (NILP (liszt2))
+{
+return intersectionp ? Qnil : liszt1;
+}
+get_check_match_function (&test, test_not, Qnil, Qnil, key,
+&test_not_unboundp, &check_test);
+GCPRO3 (tail, keyed, liszt1);
+tortoise_elt = tail = liszt1, count = 0;
+while (CONSP (tail) ? (elt = XCAR (tail), 1) : NILP (tail) ? 0 :
+(signal_malformed_list_error (liszt1), 0))
+{
+keyed = KEY (key, elt);
+if (NILP (list_position_cons_before (&ignore, keyed, liszt2,
+check_test, test_not_unboundp,
+test, key, 0, Qzero, Qnil))
+== intersectionp)
+{
+if (NILP (prev_tail))
+{
+liszt1 = XCDR (tail);
+}
+else
+{
+XSETCDR (prev_tail, XCDR (tail));
+}
+tail = XCDR (tail);
+/* List is definitely not circular now! */
+count = 0;
+}
+else
+{
+prev_tail = tail;
+tail = XCDR (tail);
+}
+if (count++ < CIRCULAR_LIST_SUSPICION_LENGTH) continue;
+if (count & 1)
+{
+tortoise_elt = XCDR (tortoise_elt);
+}
+if (EQ (elt, tortoise_elt))
+{
+signal_circular_list_error (liszt1);
+}
+}
+UNGCPRO;
+return liszt1;
+}
+DEFUN ("intersection", Fintersection, 2, MANY, 0, /*
+Combine LIST1 and LIST2 using a set-intersection operation.
+The result list contains all items that appear in both LIST1 and LIST2.
+This is a non-destructive function; it makes a copy of the data if necessary
+to avoid corrupting the original LIST1 and LIST2.
+A non-nil value for the :stable keyword, not specified by Common Lisp, means
+return the items in the order they appear in LIST1.
+See `union' for the meaning of :test, :test-not and :key."
+arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT STABLE)
+*/
+(int nargs, Lisp_Object *args))
+{
+return venn (Qintersection, nargs, args, 1);
+}
+DEFUN ("nintersection", Fnintersection, 2, MANY, 0, /*
+Combine LIST1 and LIST2 using a set-intersection operation.
+The result list contains all items that appear in both LIST1 and LIST2.
+This is a destructive function; it reuses the storage of LIST1 whenever
+possible.
+See `union' for the meaning of :test, :test-not and :key."
+arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT)
+*/
+(int nargs, Lisp_Object *args))
+{
+return nvenn (Qnintersection, nargs, args, 1);
+}
+DEFUN ("subsetp", Fsubsetp, 2, MANY, 0, /*
+Return non-nil if every element of LIST1 also appears in LIST2.
+See `union' for the meaning of the keyword arguments.
+arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT)
+*/
+(int nargs, Lisp_Object *args))
+{
+return venn (Qsubsetp, nargs, args, 0);
+}
+DEFUN ("set-difference", Fset_difference, 2, MANY, 0, /*
+Combine LIST1 and LIST2 using a set-difference operation.
+The result list contains all items that appear in LIST1 but not LIST2.  This
+is a non-destructive function; it makes a copy of the data if necessary to
+avoid corrupting the original LIST1 and LIST2.
+See `union' for the meaning of :test, :test-not and :key.
+A non-nil value for the :stable keyword, not specified by Common Lisp, means
+return the items in the order they appear in LIST1.
+arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT STABLE)
+*/
+(int nargs, Lisp_Object *args))
+{
+return venn (Qset_difference, nargs, args, 0);
+}
+DEFUN ("nset-difference", Fnset_difference, 2, MANY, 0, /*
+Combine LIST1 and LIST2 using a set-difference operation.
+The result list contains all items that appear in LIST1 but not LIST2.  This
+is a destructive function; it reuses the storage of LIST1 whenever possible.
+See `union' for the meaning of :test, :test-not and :key."
+arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT)
+*/
+(int nargs, Lisp_Object *args))
+{
+return nvenn (Qnset_difference, nargs, args, 0);
+}
+DEFUN ("nunion", Fnunion, 2, MANY, 0, /*
+Combine LIST1 and LIST2 using a set-union operation.
+The result list contains all items that appear in either LIST1 or LIST2.
+This is a destructive function, it reuses the storage of LIST1 whenever
+possible.
+See `union' for the meaning of :test, :test-not and :key.
+arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT)
+*/
+(int nargs, Lisp_Object *args))
+{
+args[0] = nvenn (Qnunion, nargs, args, 0);
+return bytecode_nconc2 (args);
+}
+DEFUN ("union", Funion, 2, MANY, 0, /*
+Combine LIST1 and LIST2 using a set-union operation.
+The result list contains all items that appear in either LIST1 or LIST2.
+This is a non-destructive function; it makes a copy of the data if necessary
+to avoid corrupting the original LIST1 and LIST2.
+The keywords :test and :test-not specify two-argument test and negated-test
+predicates, respectively; :test defaults to `eql'.  See `member*' for more
+information.
+:key specifies a one-argument function that transforms elements of LIST1
+and LIST2 into \"comparison keys\" before the test predicate is applied.
+For example, if :key is #'car, then the car of elements from LIST1 is
+compared with the car of elements from LIST2.  The :key function, however,
+does not affect the elements in the returned list, which are taken directly
+from the elements in LIST1 and LIST2.
+A non-nil value for the :stable keyword, not specified by Common Lisp, means
+return the items of LIST1 in order, followed by the remaining items of LIST2
+in the order they occur in LIST2.
+arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT STABLE)
+*/
+(int nargs, Lisp_Object *args))
+{
+Lisp_Object liszt1 = args[0], liszt2 = args[1], ignore = Qnil;
+Lisp_Object elt = Qnil, tail = Qnil, keyed = Qnil, result, result_tail;
+Elemcount len;
+Boolint test_not_unboundp = 1;
+check_test_func_t check_test = NULL, check_match = NULL;
+struct gcpro gcpro1, gcpro2, gcpro3;
+PARSE_KEYWORDS (Funion, nargs, args, 4, (test, key, test_not, stable), NULL);
+CHECK_LIST (liszt1);
+CHECK_LIST (liszt2);
+CHECK_KEY_ARGUMENT (key);
+if (NILP (liszt1))
+{
+return liszt2;
+}
+if (NILP (liszt2))
+{
+return liszt1;
+}
+check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key,
+&test_not_unboundp, &check_test);
+GCPRO3 (tail, keyed, result);
+if (NILP (stable))
+{
+result = liszt2;
+{
+EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, liszt1, tail, len)
+{
+keyed = KEY (key, elt);
+if (NILP (list_position_cons_before (&ignore, keyed, liszt2,
+check_test, test_not_unboundp,
+test, key, 0, Qzero, Qnil)))
+{
+/* The Lisp version of #'union used to check which list was
+longer, and use that as the tail of the constructed
+list. That fails when the order of arguments to TEST is
+specified, as is the case for these functions. We could
+pass the reverse_check argument to
+list_position_cons_before, but that means any key argument
+is called an awful lot more, so it's a space win but not
+a time win. */
+result = Fcons (elt, result);
+}
+}
+}
+}
+else
+{
+result = result_tail = Qnil;
+/* The standard `union' doesn't produce a "stable" union -- it
+iterates over the second list instead of the first one, and returns
+the values in backwards order.  According to the CLTL2
+documentation, `union' is not required to preserve the ordering of
+elements in any fashion; providing the functionality for a stable
+union is an XEmacs extension. */
+{
+EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, liszt2, tail, len)
+{
+if (NILP (list_position_cons_before (&ignore, elt, liszt1,
+check_match, test_not_unboundp,
+test, key, 1, Qzero, Qnil)))
+{
+if (NILP (result))
+{
+result = result_tail = Fcons (elt, Qnil);
+}
+else
+{
+XSETCDR (result_tail, Fcons (elt, Qnil));
+result_tail = XCDR (result_tail);
+}
+}
+}
+}
+result = NILP (result) ? liszt1 : nconc2 (Fcopy_list (liszt1), result);
+}
+UNGCPRO;
+return result;
+}
+DEFUN ("set-exclusive-or", Fset_exclusive_or, 2, MANY, 0, /*
+Combine LIST1 and LIST2 using a set-exclusive-or operation.
+The result list contains all items that appear in exactly one of LIST1, LIST2.
+This is a non-destructive function; it makes a copy of the data if necessary
+to avoid corrupting the original LIST1 and LIST2.
+See `union' for the meaning of :test, :test-not and :key.
+A non-nil value for the :stable keyword, not specified by Common Lisp, means
+return the items in the order they appear in LIST1, followed by the
+remaining items in the order they appear in LIST2.
+arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT)
+*/
+(int nargs, Lisp_Object *args))
+{
+Lisp_Object liszt1 = args[0], liszt2 = args[1], elt = Qnil, tail = Qnil;
+Lisp_Object result = Qnil, result_tail = Qnil, keyed = Qnil, ignore = Qnil;
+Elemcount len;
+Boolint test_not_unboundp = 1;
+check_test_func_t check_match = NULL, check_test = NULL;
+struct gcpro gcpro1, gcpro2, gcpro3;
+PARSE_KEYWORDS (Fset_exclusive_or, nargs, args, 4,
+(test, key, test_not, stable), NULL);
+CHECK_LIST (liszt1);
+CHECK_LIST (liszt2);
+CHECK_KEY_ARGUMENT (key);
+if (NILP (liszt2))
+{
+return liszt1;
+}
+check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key,
+&test_not_unboundp, &check_test);
+GCPRO3 (tail, keyed, result);
+{
+EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, liszt1, tail, len)
+{
+keyed = KEY (key, elt);
+if (NILP (list_position_cons_before (&ignore, keyed, liszt2,
+check_test, test_not_unboundp,
+test, key, 0, Qzero, Qnil)))
+{
+if (NILP (stable))
+{
+result = Fcons (elt, result);
+}
+else if (NILP (result))
+{
+result = result_tail = Fcons (elt, Qnil);
+}
+else
+{
+XSETCDR (result_tail, Fcons (elt, Qnil));
+result_tail = XCDR (result_tail);
+}
+}
+}
+}
+{
+EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, liszt2, tail, len)
+{
+if (NILP (list_position_cons_before (&ignore, elt, liszt1,
+check_match, test_not_unboundp,
+test, key, 1, Qzero, Qnil)))
+{
+if (NILP (stable))
+{
+result = Fcons (elt, result);
+}
+else if (NILP (result))
+{
+result = result_tail = Fcons (elt, Qnil);
+}
+else
+{
+XSETCDR (result_tail, Fcons (elt, Qnil));
+result_tail = XCDR (result_tail);
+}
+}
+}
+}
+UNGCPRO;
+return result;
+}
+DEFUN ("nset-exclusive-or", Fnset_exclusive_or, 2, MANY, 0, /*
+Combine LIST1 and LIST2 using a set-exclusive-or operation.
+The result list contains all items that appear in exactly one of LIST1 and
+LIST2.  This is a destructive function; it reuses the storage of LIST1 and
+LIST2 whenever possible.
+See `union' for the meaning of :test, :test-not and :key.
+arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT)
+*/
+(int nargs, Lisp_Object *args))
+{
+Lisp_Object liszt1 = args[0], liszt2 = args[1], elt = Qnil, tail = Qnil;
+Lisp_Object result = Qnil, tortoise_elt = Qnil, keyed = Qnil, swap;
+Lisp_Object prev_tail = Qnil, ignore = Qnil;
+Elemcount count;
+Boolint test_not_unboundp = 1;
+check_test_func_t check_match = NULL, check_test = NULL;
+struct gcpro gcpro1, gcpro2, gcpro3;
+PARSE_KEYWORDS (Fnset_exclusive_or, nargs, args, 4,
+(test, key, test_not, stable), NULL);
+CHECK_LIST (liszt1);
+CHECK_LIST (liszt2);
+CHECK_KEY_ARGUMENT (key);
+if (NILP (liszt2))
+{
+return liszt1;
+}
+check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key,
+&test_not_unboundp, &check_test);
+GCPRO3 (tail, keyed, result);
+tortoise_elt = tail = liszt1, count = 0;
+while (CONSP (tail) ? (elt = XCAR (tail), 1) : NILP (tail) ? 0 :
+(signal_malformed_list_error (liszt1), 0))
+{
+keyed = KEY (key, elt);
+if (NILP (list_position_cons_before (&ignore, keyed, liszt2,
+check_test, test_not_unboundp,
+test, key, 0, Qzero, Qnil)))
+{
+swap = XCDR (tail);
+if (NILP (prev_tail))
+{
+liszt1 = XCDR (tail);
+}
+else
+{
+XSETCDR (prev_tail, swap);
+}
+XSETCDR (tail, result);
+result = tail;
+tail = swap;
+/* List is definitely not circular now! */
+count = 0;
+}
+else
+{
+prev_tail = tail;
+tail = XCDR (tail);
+}
+if (count++ < CIRCULAR_LIST_SUSPICION_LENGTH) continue;
+if (count & 1)
+{
+tortoise_elt = XCDR (tortoise_elt);
+}
+if (EQ (elt, tortoise_elt))
+{
+signal_circular_list_error (liszt1);
+}
+}
+tortoise_elt = tail = liszt2, count = 0;
+while (CONSP (tail) ? (elt = XCAR (tail), 1) : NILP (tail) ? 0 :
+(signal_malformed_list_error (liszt2), 0))
+{
+/* Need to leave the key calculation to list_position_cons_before(). */
+if (NILP (list_position_cons_before (&ignore, elt, liszt1,
+check_match, test_not_unboundp,
+test, key, 1, Qzero, Qnil)))
+{
+swap = XCDR (tail);
+XSETCDR (tail, result);
+result = tail;
+tail = swap;
+count = 0;
+}
+else
+{
+tail = XCDR (tail);
+}
+if (count++ < CIRCULAR_LIST_SUSPICION_LENGTH) continue;
+if (count & 1)
+{
+tortoise_elt = XCDR (tortoise_elt);
+}
+if (EQ (elt, tortoise_elt))
+{
+signal_circular_list_error (liszt1);
+}
+}
+UNGCPRO;
+return result;
+}
 Lisp_Object
 add_suffix_to_symbol (Lisp_Object symbol, const Ascbyte *ascii_string)
 {
 return Fintern (concat2 (Fsymbol_name (symbol),
 			   build_ascstring (ascii_string)),
 {
 return Fintern (concat2 (build_ascstring (ascii_string),
 			   Fsymbol_name (symbol)),
 		  Qnil);
 }
 /* #### this function doesn't belong in this file! */
 #ifdef HAVE_GETLOADAVG
 #ifdef HAVE_SYS_LOADAVG_H
 syms_of_fns (void)
 {
 INIT_LISP_OBJECT (bit_vector);
 DEFSYMBOL (Qstring_lessp);
-DEFSYMBOL (Qsort);
 DEFSYMBOL (Qmerge);
 DEFSYMBOL (Qfill);
 DEFSYMBOL (Qidentity);
 DEFSYMBOL (Qvector);
 DEFSYMBOL (Qarray);
 DEFSYMBOL (Qlist);
 DEFSYMBOL (Qbit_vector);
 defsymbol (&QsortX, "sort*");
 DEFSYMBOL (Qreduce);
 DEFSYMBOL (Qreplace);
+DEFSYMBOL (Qposition);
+DEFSYMBOL (Qfind);
+defsymbol (&QdeleteX, "delete*");
+defsymbol (&QremoveX, "remove*");
 DEFSYMBOL (Qmapconcat);
 defsymbol (&QmapcarX, "mapcar*");
 DEFSYMBOL (Qmapvector);
 DEFSYMBOL (Qmapcan);
 DEFSYMBOL (Qsome);
 DEFSYMBOL (Qevery);
 DEFSYMBOL (Qmaplist);
 DEFSYMBOL (Qmapl);
 DEFSYMBOL (Qmapcon);
+DEFSYMBOL (Qnsubstitute);
+DEFSYMBOL (Qdelete_duplicates);
+DEFSYMBOL (Qsubstitute);
+DEFSYMBOL (Qmismatch);
+DEFSYMBOL (Qintersection);
+DEFSYMBOL (Qnintersection);
+DEFSYMBOL (Qsubsetp);
+DEFSYMBOL (Qset_difference);
+DEFSYMBOL (Qnset_difference);
+DEFSYMBOL (Qnunion);
 DEFKEYWORD (Q_from_end);
 DEFKEYWORD (Q_initial_value);
 DEFKEYWORD (Q_start1);
 DEFKEYWORD (Q_start2);
 DEFKEYWORD (Q_end1);
 DEFKEYWORD (Q_end2);
+defkeyword (&Q_if_, ":if");
+DEFKEYWORD (Q_if_not);
+DEFKEYWORD (Q_test_not);
+DEFKEYWORD (Q_count);
+DEFKEYWORD (Q_stable);
 DEFSYMBOL (Qyes_or_no_p);
 DEFERROR_STANDARD (Qbase64_conversion_error, Qconversion_error);
 DEFSUBR (Fidentity);
 DEFSUBR (Frandom);
 DEFSUBR (Flength);
 DEFSUBR (Fsafe_length);
 DEFSUBR (Flist_length);
+DEFSUBR (Fcount);
 DEFSUBR (Fstring_equal);
 DEFSUBR (Fcompare_strings);
 DEFSUBR (Fstring_lessp);
 DEFSUBR (Fstring_modified_tick);
 DEFSUBR (Fappend);
 DEFSUBR (Fnbutlast);
 DEFSUBR (Fmember);
 DEFSUBR (Fold_member);
 DEFSUBR (Fmemq);
 DEFSUBR (Fold_memq);
+DEFSUBR (FmemberX);
+DEFSUBR (Fadjoin);
 DEFSUBR (Fassoc);
 DEFSUBR (Fold_assoc);
 DEFSUBR (Fassq);
 DEFSUBR (Fold_assq);
 DEFSUBR (Frassoc);
 DEFSUBR (Fold_rassoc);
 DEFSUBR (Frassq);
 DEFSUBR (Fold_rassq);
+DEFSUBR (Fposition);
+DEFSUBR (Ffind);
 DEFSUBR (Fdelete);
 DEFSUBR (Fold_delete);
 DEFSUBR (Fdelq);
 DEFSUBR (Fold_delq);
+DEFSUBR (FdeleteX);
+DEFSUBR (FremoveX);
 DEFSUBR (Fremassoc);
 DEFSUBR (Fremassq);
 DEFSUBR (Fremrassoc);
 DEFSUBR (Fremrassq);
+DEFSUBR (Fdelete_duplicates);
+DEFSUBR (Fremove_duplicates);
 DEFSUBR (Fnreverse);
 DEFSUBR (Freverse);
 DEFSUBR (FsortX);
-Ffset (intern ("sort"), QsortX);
 DEFSUBR (Fmerge);
 DEFSUBR (Fplists_eq);
 DEFSUBR (Fplists_equal);
 DEFSUBR (Flax_plists_eq);
 DEFSUBR (Flax_plists_equal);
 DEFSUBR (Fobject_setplist);
 DEFSUBR (Fequal);
 DEFSUBR (Fequalp);
 DEFSUBR (Fold_equal);
 DEFSUBR (Ffill);
-Ffset (intern ("fillarray"), Qfill);
+DEFSUBR (FassocX);
+DEFSUBR (FrassocX);
 DEFSUBR (Fnconc);
 DEFSUBR (FmapcarX);
 DEFSUBR (Fmapvector);
 DEFSUBR (Fmapcan);
 DEFSUBR (Fmapconcat);
 DEFSUBR (Fmap);
 DEFSUBR (Fmap_into);
 DEFSUBR (Fsome);
 DEFSUBR (Fevery);
-Ffset (intern ("mapc-internal"), Fsymbol_function (intern ("mapc")));
+Ffset (intern ("mapc-internal"), Qmapc);
-Ffset (intern ("mapcar"), Fsymbol_function (intern ("mapcar*")));
+Ffset (intern ("mapcar"), QmapcarX);
 DEFSUBR (Fmaplist);
 DEFSUBR (Fmapl);
 DEFSUBR (Fmapcon);
 DEFSUBR (Freduce);
 DEFSUBR (Freplace_list);
 DEFSUBR (Freplace);
+DEFSUBR (Fsubsetp);
+DEFSUBR (Fnsubstitute);
+DEFSUBR (Fsubstitute);
+DEFSUBR (Fsublis);
+DEFSUBR (Fnsublis);
+DEFSUBR (Fsubst);
+DEFSUBR (Fnsubst);
+DEFSUBR (Ftree_equal);
+DEFSUBR (Fmismatch);
+DEFSUBR (Fsearch);
+DEFSUBR (Funion);
+DEFSUBR (Fnunion);
+DEFSUBR (Fintersection);
+DEFSUBR (Fnintersection);
+DEFSUBR (Fset_difference);
+DEFSUBR (Fnset_difference);
+DEFSUBR (Fset_exclusive_or);
+DEFSUBR (Fnset_exclusive_or);
 DEFSUBR (Fload_average);
 DEFSUBR (Ffeaturep);
 DEFSUBR (Frequire);
 DEFSUBR (Fprovide);
 DEFSUBR (Fbase64_encode_region);

Mercurial > hg > xemacs-beta

comparison src/fns.c @ 5448:89331fa1c819