bug#69709: `sort` interface improvement and universal ordering predicate

["Mattias Engdegård" <mattias.engdegard@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 588 bytes --]

29 mars 2024 kl. 12.38 skrev Daniel Mendler <mail@daniel-mendler.de>:

> I would
> like to back-port the new feature in the Compat library, specifically in
> the emacs-30 branch of the Compat repository. I've seen you mentioned
> some pure Lisp code, implementing the new feature, in a slower, but
> backward compatible way, which we could perhaps use?

Here is my proof-of-concept hack that maybe you could use as starting point. It's incomplete but I think you can fill in the blanks. You could use the tests in fns-tests.el, perhaps adapted to fit. Let us know how it goes.


[-- Attachment #2: compatsort.el --]
[-- Type: application/octet-stream, Size: 2787 bytes --]

;;; -*- lexical-binding: t -*-

;; Quick-and-dirty compat backport of Emacs 30 `sort' keyword args to
;; older versions

(defun value< (a b)
  "Cheapo Lisp impl of Emacs 30 `value<'."
  (cond
   ((numberp a) (< a b))
   ((stringp a) (string< a b))
   ((symbolp a)
    (or (and (null a) (consp b))
        (string< a b)))
   ((consp a)
    (while (and (consp b) (equal (car a) (car b)))
      (setq a (cdr a))
      (setq b (cdr b)))
    (if (consp a)
        (if (consp b)
            (value< (car a) (car b))
          (if b
              (error "value< type mismatch: %S %S" a b)
            nil))
      (value< a b)))
   ((vectorp a)
    (if (vectorp b)
        (let* ((na (length a))
               (nb (length b))
               (n (min na nb))
               (i 0))
          (while (and (< i n) (equal (aref a i) (aref b i)))
            (setq i (1+ i)))
          (if (< i n)
              (value< (aref a i) (aref b i))
            (< n nb)))
      (error "value< type mismatch: %S %S" a b)))
   ;; FIXME: records, markers, buffers, processes, bool-vectors
   (t (if (eq (type-of a) (type-of b))
          nil
        (error "value< type mismatch: %S %S" a b)))))

(defun sort-30 (seq key lessp reverse in-place)
  (unless lessp
    (setq lessp #'value<))
  ;; careful, can't just assign to lessp here -- use a new binding
  (let ((new-lessp
         (if key
             ;; FIXME: this is a bit inefficient if `key' is expensive
             (lambda (a b) (funcall lessp (funcall key a) (funcall key b)))
           lessp)))
    (unless in-place
      (setq seq (copy-sequence seq)))
    ;; FIXME: this is actually not quite correct when sorting lists
    ;; in-place -- we should really update the original list.
    (if reverse
        (nreverse (sort (if in-place (nreverse seq) (reverse seq))
                        new-lessp))
      (sort seq new-lessp))))

(defun sort-compat-transformer (form &rest args)
  "Compiler macro for `sort' that takes Emacs 30 keyword args."
  (let ((nargs (length args)))
    (if (zerop (% nargs 2))
        form                    ; old syntax, or error -- no transform
      ;; new syntax
      (let ((seq (car args))
            (key nil)
            (in-place nil)
            (reverse nil)
            (lessp nil))
        (setq args (cdr args))
        (while (cdr args)
          (let ((kw (car args))
                (val (cadr args)))
            (pcase kw
              (:key (setq key val))
              (:lessp (setq lessp val))
              (:reverse (setq reverse val))
              (:in-place (setq in-place val))
              (_ (error "bad `sort' keyword `%s'" kw))))
          (setq args (cddr args)))
        `(sort-30 ,seq ,key ,lessp ,reverse ,in-place)))))
    
(put 'sort 'compiler-macro 'sort-compat-transformer)