New `sort` keyword arguments (bug#69709)

Add the :key, :lessp, :reverse and :in-place keyword arguments.
The old calling style remains available and is unchanged.

* src/fns.c (sort_list, sort_vector, Fsort):
* src/sort.c (tim_sort):
Add keyword arguments with associated new features.
All callers of Fsort adapted.
* test/src/fns-tests.el (fns-tests--shuffle-vector, fns-tests-sort-kw):
New test.
* doc/lispref/sequences.texi (Sequence Functions): Update manual.
* etc/NEWS: Announce.

5 files changed, 93 insertions, 24 deletions

diff --git a/src/dired.c b/src/dired.c
index 9a372201ae0..bfbacf70917 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -351,7 +351,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
   specpdl_ptr = specpdl_ref_to_ptr (count);
 
   if (NILP (nosort))
-    list = Fsort (Fnreverse (list),
+    list = CALLN (Fsort, Fnreverse (list),
 		  attrs ? Qfile_attributes_lessp : Qstring_lessp);
 
   (void) directory_volatile;
diff --git a/src/fns.c b/src/fns.c
index a3ef99f67a8..7eacf99cbba 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -2353,7 +2353,8 @@ See also the function `nreverse', which is used more often.  */)
    is destructively reused to hold the sorted result.  */
 
 static Lisp_Object
-sort_list (Lisp_Object list, Lisp_Object predicate, Lisp_Object keyfunc)
+sort_list (Lisp_Object list, Lisp_Object predicate, Lisp_Object keyfunc,
+	   bool reverse)
 {
   ptrdiff_t length = list_length (list);
   if (length < 2)
@@ -2369,7 +2370,7 @@ sort_list (Lisp_Object list, Lisp_Object predicate, Lisp_Object keyfunc)
 	  result[i] = Fcar (tail);
 	  tail = XCDR (tail);
 	}
-      tim_sort (predicate, keyfunc, result, length);
+      tim_sort (predicate, keyfunc, result, length, reverse);
 
       ptrdiff_t i = 0;
       tail = list;
@@ -2388,27 +2389,86 @@ sort_list (Lisp_Object list, Lisp_Object predicate, Lisp_Object keyfunc)
    algorithm.  */
 
 static void
-sort_vector (Lisp_Object vector, Lisp_Object predicate, Lisp_Object keyfunc)
+sort_vector (Lisp_Object vector, Lisp_Object predicate, Lisp_Object keyfunc,
+	     bool reverse)
 {
   ptrdiff_t length = ASIZE (vector);
   if (length < 2)
     return;
 
-  tim_sort (predicate, keyfunc, XVECTOR (vector)->contents, length);
+  tim_sort (predicate, keyfunc, XVECTOR (vector)->contents, length, reverse);
 }
 
-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.  SEQ 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)
+DEFUN ("sort", Fsort, Ssort, 1, MANY, 0,
+       doc: /* Sort SEQ, stably, and return the sorted sequence.
+SEQ should be a list or vector.
+Optional arguments are specified as keyword/argument pairs.  The following
+arguments are defined:
+
+:key FUNC -- FUNC is a function that takes a single element from SEQ and
+  returns the key value to be used in comparison.  If absent or nil,
+  `identity' is used.
+
+:lessp FUNC -- FUNC is a function that takes two arguments and returns
+  non-nil if the first element should come before the second.
+  If absent or nil, `value<' is used.
+
+:reverse BOOL -- if BOOL is non-nil, the sorting order implied by FUNC is
+  reversed.  This does not affect stability: equal elements still retain
+  their order in the input sequence.
+
+:in-place BOOL -- if BOOL is non-nil, SEQ is sorted in-place and returned.
+  Otherwise, a sorted copy of SEQ is returned and SEQ remains unmodified;
+  this is the default.
+
+For compatibility, the calling convention (sort SEQ LESSP) can also be used;
+in this case, sorting is always done in-place.
+
+usage: (sort SEQ &key KEY LESSP REVERSE IN-PLACE)  */)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
+  Lisp_Object seq = args[0];
+  Lisp_Object key = Qnil;
+  Lisp_Object lessp = Qnil;
+  bool inplace = false;
+  bool reverse = false;
+  if (nargs == 2)
+    {
+      /* old-style invocation without keywords */
+      lessp = args[1];
+      inplace = true;
+    }
+  else if ((nargs & 1) == 0)
+    error ("Invalid argument list");
+  else
+    for (ptrdiff_t i = 1; i < nargs - 1; i += 2)
+      {
+	if (EQ (args[i], QCkey))
+	  key = args[i + 1];
+	else if (EQ (args[i], QClessp))
+	  lessp = args[i + 1];
+	else if (EQ (args[i], QCin_place))
+	  inplace = !NILP (args[i + 1]);
+	else if (EQ (args[i], QCreverse))
+	  reverse = !NILP (args[i + 1]);
+	else
+	  signal_error ("Invalid keyword argument", args[i]);
+      }
+
+  if (NILP (lessp))
+    /* FIXME: normalise it as Qnil instead, and special-case it in tim_sort?
+       That would remove the funcall overhead for the common case.  */
+    lessp = Qvaluelt;
+
+  /* FIXME: for lists it may be slightly faster to make the copy after
+     sorting? Measure.  */
+  if (!inplace)
+    seq = Fcopy_sequence (seq);
+
   if (CONSP (seq))
-    seq = sort_list (seq, predicate, Qnil);
+    seq = sort_list (seq, lessp, key, reverse);
   else if (VECTORP (seq))
-    sort_vector (seq, predicate, Qnil);
+    sort_vector (seq, lessp, key, reverse);
   else if (!NILP (seq))
     wrong_type_argument (Qlist_or_vector_p, seq);
   return seq;
@@ -6860,4 +6920,10 @@ For best results this should end in a space.  */);
   DEFSYM (Qfrom__tty_menu_p, "from--tty-menu-p");
   DEFSYM (Qyes_or_no_p, "yes-or-no-p");
   DEFSYM (Qy_or_n_p, "y-or-n-p");
+
+  DEFSYM (QCkey, ":key");
+  DEFSYM (QClessp, ":lessp");
+  DEFSYM (QCin_place, ":in-place");
+  DEFSYM (QCreverse, ":reverse");
+  DEFSYM (Qvaluelt, "value<");
 }
diff --git a/src/lisp.h b/src/lisp.h
index 14c0b8e4d1c..6226ab33244 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4299,7 +4299,8 @@ extern void syms_of_fns (void);
 extern void mark_fns (void);
 
 /* Defined in sort.c  */
-extern void tim_sort (Lisp_Object, Lisp_Object, Lisp_Object *, const ptrdiff_t);
+extern void tim_sort (Lisp_Object, Lisp_Object, Lisp_Object *, const ptrdiff_t,
+		      bool);
 
 /* Defined in floatfns.c.  */
 verify (FLT_RADIX == 2 || FLT_RADIX == 16);
diff --git a/src/pdumper.c b/src/pdumper.c
index c7ebb38dea5..ac8bf6f31f4 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -3368,7 +3368,7 @@ dump_sort_copied_objects (struct dump_context *ctx)
      file and the copy into Emacs in-order, where prefetch will be
      most effective.  */
   ctx->copied_queue =
-    Fsort (Fnreverse (ctx->copied_queue),
+    CALLN (Fsort, Fnreverse (ctx->copied_queue),
            Qdump_emacs_portable__sort_predicate_copied);
 }
 
@@ -3935,7 +3935,7 @@ drain_reloc_list (struct dump_context *ctx,
 {
   struct dump_flags old_flags = ctx->flags;
   ctx->flags.pack_objects = true;
-  Lisp_Object relocs = Fsort (Fnreverse (*reloc_list),
+  Lisp_Object relocs = CALLN (Fsort, Fnreverse (*reloc_list),
                               Qdump_emacs_portable__sort_predicate);
   *reloc_list = Qnil;
   dump_align_output (ctx, max (alignof (struct dump_reloc),
@@ -4057,7 +4057,7 @@ static void
 dump_do_fixups (struct dump_context *ctx)
 {
   dump_off saved_offset = ctx->offset;
-  Lisp_Object fixups = Fsort (Fnreverse (ctx->fixups),
+  Lisp_Object fixups = CALLN (Fsort, Fnreverse (ctx->fixups),
                               Qdump_emacs_portable__sort_predicate);
   Lisp_Object prev_fixup = Qnil;
   ctx->fixups = Qnil;
diff --git a/src/sort.c b/src/sort.c
index d91993c8c65..a0f127c35b3 100644
--- a/src/sort.c
+++ b/src/sort.c
@@ -1072,11 +1072,11 @@ resolve_fun (Lisp_Object fun)
 }
 
 /* Sort the array SEQ with LENGTH elements in the order determined by
-   PREDICATE.  */
-
+   PREDICATE (where Qnil means value<) and KEYFUNC (where Qnil means identity),
+   optionally reversed.  */
 void
 tim_sort (Lisp_Object predicate, Lisp_Object keyfunc,
-	  Lisp_Object *seq, const ptrdiff_t length)
+	  Lisp_Object *seq, const ptrdiff_t length, bool reverse)
 {
   /* FIXME: optimise for the predicate being value<; at the very
      least we'd go without the Lisp funcall overhead.  */
@@ -1091,9 +1091,8 @@ tim_sort (Lisp_Object predicate, Lisp_Object keyfunc,
   if (EQ (keyfunc, Qidentity))
     keyfunc = Qnil;
 
-  /* FIXME: consider a built-in reverse sorting flag: we would reverse
-     the input in-place here and reverse it back just before
-     returning.  */
+  if (reverse)
+    reverse_slice (seq, seq + length);    /* preserve stability */
 
   if (NILP (keyfunc))
     {
@@ -1159,6 +1158,9 @@ tim_sort (Lisp_Object predicate, Lisp_Object keyfunc,
   eassume (ms.pending[0].len == length);
   lo = ms.pending[0].base;
 
+  if (reverse)
+    reverse_slice (seq, seq + length);
+
   if (ms.a.keys != ms.temparray || allocated_keys != NULL)
     unbind_to (ms.count, Qnil);
 }