#include <time.h>
#include <intprops.h>
+#include <vla.h>
#include "lisp.h"
#include "commands.h"
static Lisp_Object Qmd5, Qsha1, Qsha224, Qsha256, Qsha384, Qsha512;
+static void sort_vector_copy (Lisp_Object, ptrdiff_t,
+ Lisp_Object [restrict], Lisp_Object [restrict]);
static bool internal_equal (Lisp_Object, Lisp_Object, int, bool, Lisp_Object);
DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
return i1 < SCHARS (s2) ? Qt : Qnil;
}
-DEFUN ("string-collate-lessp", Fstring_collate_lessp, Sstring_collate_lessp, 2, 2, 0,
+DEFUN ("string-collate-lessp", Fstring_collate_lessp, Sstring_collate_lessp, 2, 4, 0,
doc: /* Return t if first arg string is less than second in collation order.
-
-Case is significant. Symbols are also allowed; their print names are
-used instead.
+Symbols are also allowed; their print names are used instead.
This function obeys the conventions for collation order in your
locale settings. For example, punctuation and whitespace characters
-are considered less significant for sorting.
+might be considered less significant for sorting:
\(sort '\("11" "12" "1 1" "1 2" "1.1" "1.2") 'string-collate-lessp)
=> \("11" "1 1" "1.1" "12" "1 2" "1.2")
-If your system does not support a locale environment, this function
-behaves like `string-lessp'.
+The optional argument LOCALE, a string, overrides the setting of your
+current locale identifier for collation. The value is system
+dependent; a LOCALE \"en_US.UTF-8\" is applicable on POSIX systems,
+while it would be, e.g., \"enu_USA.1252\" on MS-Windows systems.
+
+If IGNORE-CASE is non-nil, characters are converted to lower-case
+before comparing them.
+
+To emulate Unicode-compliant collation on MS-Windows systems,
+bind `w32-collate-ignore-punctuation' to a non-nil value, since
+the codeset part of the locale cannot be \"UTF-8\" on MS-Windows.
-If the environment variable \"LC_COLLATE\" is set in `process-environment',
-it overrides the setting of your current locale. */)
- (Lisp_Object s1, Lisp_Object s2)
+If your system does not support a locale environment, this function
+behaves like `string-lessp'. */)
+ (Lisp_Object s1, Lisp_Object s2, Lisp_Object locale, Lisp_Object ignore_case)
{
#if defined __STDC_ISO_10646__ || defined WINDOWSNT
/* Check parameters. */
s2 = SYMBOL_NAME (s2);
CHECK_STRING (s1);
CHECK_STRING (s2);
+ if (!NILP (locale))
+ CHECK_STRING (locale);
- return (str_collate (s1, s2) < 0) ? Qt : Qnil;
+ return (str_collate (s1, s2, locale, ignore_case) < 0) ? Qt : Qnil;
#else /* !__STDC_ISO_10646__, !WINDOWSNT */
return Fstring_lessp (s1, s2);
#endif /* !__STDC_ISO_10646__, !WINDOWSNT */
}
-DEFUN ("string-collate-equalp", Fstring_collate_equalp, Sstring_collate_equalp, 2, 2, 0,
+DEFUN ("string-collate-equalp", Fstring_collate_equalp, Sstring_collate_equalp, 2, 4, 0,
doc: /* Return t if two strings have identical contents.
-
-Case is significant. Symbols are also allowed; their print names are
-used instead.
+Symbols are also allowed; their print names are used instead.
This function obeys the conventions for collation order in your locale
settings. For example, characters with different coding points but
-the same meaning are considered as equal, like different grave accent
-unicode characters.
+the same meaning might be considered as equal, like different grave
+accent Unicode characters:
\(string-collate-equalp \(string ?\\uFF40) \(string ?\\u1FEF))
=> t
+The optional argument LOCALE, a string, overrides the setting of your
+current locale identifier for collation. The value is system
+dependent; a LOCALE \"en_US.UTF-8\" is applicable on POSIX systems,
+while it would be \"enu_USA.1252\" on MS Windows systems.
+
+If IGNORE-CASE is non-nil, characters are converted to lower-case
+before comparing them.
+
+To emulate Unicode-compliant collation on MS-Windows systems,
+bind `w32-collate-ignore-punctuation' to a non-nil value, since
+the codeset part of the locale cannot be \"UTF-8\" on MS-Windows.
+
If your system does not support a locale environment, this function
behaves like `string-equal'.
-If the environment variable \"LC_COLLATE\" is set in `process-environment',
-it overrides the setting of your current locale. */)
- (Lisp_Object s1, Lisp_Object s2)
+Do NOT use this function to compare file names for equality, only
+for sorting them. */)
+ (Lisp_Object s1, Lisp_Object s2, Lisp_Object locale, Lisp_Object ignore_case)
{
#if defined __STDC_ISO_10646__ || defined WINDOWSNT
/* Check parameters. */
s2 = SYMBOL_NAME (s2);
CHECK_STRING (s1);
CHECK_STRING (s2);
+ if (!NILP (locale))
+ CHECK_STRING (locale);
- return (str_collate (s1, s2) == 0) ? Qt : Qnil;
+ return (str_collate (s1, s2, locale, ignore_case) == 0) ? Qt : Qnil;
#else /* !__STDC_ISO_10646__, !WINDOWSNT */
return Fstring_equal (s1, s2);
wrong_type_argument (Qsequencep, seq);
return new;
}
-\f
-DEFUN ("sort", Fsort, Ssort, 2, 2, 0,
- doc: /* Sort LIST, stably, comparing elements using PREDICATE.
-Returns the sorted list. LIST is modified by side effects.
-PREDICATE is called with two elements of LIST, and should return non-nil
-if the first element should sort before the second. */)
- (Lisp_Object list, Lisp_Object predicate)
+
+/* Sort LIST using PREDICATE, preserving original order of elements
+ considered as equal. */
+
+static Lisp_Object
+sort_list (Lisp_Object list, Lisp_Object predicate)
{
Lisp_Object front, back;
register Lisp_Object len, tem;
return merge (front, back, predicate);
}
+/* Using PRED to compare, return whether A and B are in order.
+ Compare stably when A appeared before B in the input. */
+static bool
+inorder (Lisp_Object pred, Lisp_Object a, Lisp_Object b)
+{
+ return NILP (call2 (pred, b, a));
+}
+
+/* Using PRED to compare, merge from ALEN-length A and BLEN-length B
+ into DEST. Argument arrays must be nonempty and must not overlap,
+ except that B might be the last part of DEST. */
+static void
+merge_vectors (Lisp_Object pred,
+ ptrdiff_t alen, Lisp_Object const a[restrict VLA_ELEMS (alen)],
+ ptrdiff_t blen, Lisp_Object const b[VLA_ELEMS (blen)],
+ Lisp_Object dest[VLA_ELEMS (alen + blen)])
+{
+ eassume (0 < alen && 0 < blen);
+ Lisp_Object const *alim = a + alen;
+ Lisp_Object const *blim = b + blen;
+
+ while (true)
+ {
+ if (inorder (pred, a[0], b[0]))
+ {
+ *dest++ = *a++;
+ if (a == alim)
+ {
+ if (dest != b)
+ memcpy (dest, b, (blim - b) * sizeof *dest);
+ return;
+ }
+ }
+ else
+ {
+ *dest++ = *b++;
+ if (b == blim)
+ {
+ memcpy (dest, a, (alim - a) * sizeof *dest);
+ return;
+ }
+ }
+ }
+}
+
+/* Using PRED to compare, sort LEN-length VEC in place, using TMP for
+ temporary storage. LEN must be at least 2. */
+static void
+sort_vector_inplace (Lisp_Object pred, ptrdiff_t len,
+ Lisp_Object vec[restrict VLA_ELEMS (len)],
+ Lisp_Object tmp[restrict VLA_ELEMS (len >> 1)])
+{
+ eassume (2 <= len);
+ ptrdiff_t halflen = len >> 1;
+ sort_vector_copy (pred, halflen, vec, tmp);
+ if (1 < len - halflen)
+ sort_vector_inplace (pred, len - halflen, vec + halflen, vec);
+ merge_vectors (pred, halflen, tmp, len - halflen, vec + halflen, vec);
+}
+
+/* Using PRED to compare, sort from LEN-length SRC into DST.
+ Len must be positive. */
+static void
+sort_vector_copy (Lisp_Object pred, ptrdiff_t len,
+ Lisp_Object src[restrict VLA_ELEMS (len)],
+ Lisp_Object dest[restrict VLA_ELEMS (len)])
+{
+ eassume (0 < len);
+ ptrdiff_t halflen = len >> 1;
+ if (halflen < 1)
+ dest[0] = src[0];
+ else
+ {
+ if (1 < halflen)
+ sort_vector_inplace (pred, halflen, src, dest);
+ if (1 < len - halflen)
+ sort_vector_inplace (pred, len - halflen, src + halflen, dest);
+ merge_vectors (pred, halflen, src, len - halflen, src + halflen, dest);
+ }
+}
+
+/* Sort VECTOR in place using PREDICATE, preserving original order of
+ elements considered as equal. */
+
+static void
+sort_vector (Lisp_Object vector, Lisp_Object predicate)
+{
+ ptrdiff_t len = ASIZE (vector);
+ if (len < 2)
+ return;
+ ptrdiff_t halflen = len >> 1;
+ Lisp_Object *tmp;
+ Lisp_Object tmpvec = Qnil;
+ struct gcpro gcpro1, gcpro2, gcpro3;
+ GCPRO3 (vector, predicate, tmpvec);
+ if (halflen < MAX_ALLOCA / word_size)
+ tmp = alloca (halflen * word_size);
+ else
+ {
+ tmpvec = Fmake_vector (make_number (halflen), make_number (0));
+ tmp = XVECTOR (tmpvec)->contents;
+ }
+ sort_vector_inplace (predicate, len, XVECTOR (vector)->contents, tmp);
+ UNGCPRO;
+}
+
+DEFUN ("sort", Fsort, Ssort, 2, 2, 0,
+ doc: /* Sort SEQ, stably, comparing elements using PREDICATE.
+Returns the sorted sequence. SEQ should be a list or vector.
+If SEQ is a list, it is modified by side effects. PREDICATE
+is called with two elements of SEQ, and should return non-nil
+if the first element should sort before the second. */)
+ (Lisp_Object seq, Lisp_Object predicate)
+{
+ if (CONSP (seq))
+ seq = sort_list (seq, predicate);
+ else if (VECTORP (seq))
+ sort_vector (seq, predicate);
+ else if (!NILP (seq))
+ wrong_type_argument (Qsequencep, seq);
+ return seq;
+}
+
Lisp_Object
merge (Lisp_Object org_l1, Lisp_Object org_l2, Lisp_Object pred)
{
Fsetcdr (tail, l1);
return value;
}
- tem = call2 (pred, Fcar (l2), Fcar (l1));
- if (NILP (tem))
+ if (inorder (pred, Fcar (l1), Fcar (l2)))
{
tem = l1;
l1 = Fcdr (l1);