sortf.el

(cl-defmacro sortf (test &rest forms)
  (cl-labels ((collect-places (f rest-places getters setters)
                (cond ((null rest-places)
                       (funcall f (nreverse getters) (nreverse setters)))
                      (t (gv-letplace (getter setter) (car rest-places)
                           (collect-places f (cdr rest-places) (cons getter getters) (cons setter setters))))))
              (call-with-places (places f)
                (collect-places f places nil nil)))
    (call-with-places forms
      (lambda (getters setters)
        (if (<= (length forms) 15)
            (let ((vars (mapcar #'(lambda (_) (gensym)) getters))
                  (swaps nil))
              (cl-labels ((swap (i j)
                            (push `(unless (funcall ,test ,(nth i vars) ,(nth j vars))
                                     (cl-shiftf ,(nth i vars) ,(nth j vars) ,(nth i vars)))
                                  swaps)))
                `(let ,(cl-mapcar 'list vars getters)
                   ,@(progn
                       (cl-case (length forms)
                         ((0 1) nil)
                         (2  (swap 0 1))
                         (3  (swap 0 1) (swap 0 2) (swap 1 2))
                         (4  (swap 0 2) (swap 1 3) (swap 0 1) (swap 2 3) (swap 1 2))
                         (5  (swap 0 3) (swap 1 4) (swap 0 2) (swap 1 3) (swap 0 1) (swap 2 4) (swap 1 2) (swap 3 4) (swap 2 3))
                         (6  (swap 0 5) (swap 1 3) (swap 2 4) (swap 1 2) (swap 3 4) (swap 0 3) (swap 2 5) (swap 0 1) (swap 2 3) (swap 4 5) (swap 1 2) (swap 3 4))
                         (7  (swap 0 6) (swap 2 3) (swap 4 5) (swap 0 2) (swap 1 4) (swap 3 6) (swap 0 1) (swap 2 5) (swap 3 4) (swap 1 2) (swap 4 6) (swap 2 3) (swap 4 5) (swap 1 2) (swap 3 4) (swap 5 6))
                         (8  (swap 0 2) (swap 1 3) (swap 4 6) (swap 5 7) (swap 0 4) (swap 1 5) (swap 2 6) (swap 3 7) (swap 0 1) (swap 2 3) (swap 4 5) (swap 6 7) (swap 2 4) (swap 3 5) (swap 1 4) (swap 3 6) (swap 1 2) (swap 3 4) (swap 5 6))
                         (9  (swap 0 3) (swap 1 7) (swap 2 5) (swap 4 8) (swap 0 7) (swap 2 4) (swap 3 8) (swap 5 6) (swap 0 2) (swap 1 3) (swap 4 5) (swap 7 8) (swap 1 4) (swap 3 6) (swap 5 7) (swap 0 1) (swap 2 4) (swap 3 5) (swap 6 8) (swap 2 3) (swap 4 5) (swap 6 7) (swap 1 2) (swap 3 4) (swap 5 6))
                         (10 (swap 0 8) (swap 1 9) (swap 2 7) (swap 3 5) (swap 4 6) (swap 0 2) (swap 1 4) (swap 5 8) (swap 7 9) (swap 0 3) (swap 2 4) (swap 5 7) (swap 6 9) (swap 0 1) (swap 3 6) (swap 8 9) (swap 1 5) (swap 2 3) (swap 4 8) (swap 6 7) (swap 1 2) (swap 3 5) (swap 4 6) (swap 7 8) (swap 2 3) (swap 4 5) (swap 6 7) (swap 3 4) (swap 5 6))
                         (11 (swap 0 9) (swap 1 6) (swap 2 4) (swap 3 7) (swap 5 8) (swap 0 1) (swap 3 5) (swap 4 10) (swap 6 9) (swap 7 8) (swap 1 3) (swap 2 5) (swap 4 7) (swap 8 10) (swap 0 4) (swap 1 2) (swap 3 7) (swap 5 9) (swap 6 8) (swap 0 1) (swap 2 6) (swap 4 5) (swap 7 8) (swap 9 10) (swap 2 4) (swap 3 6) (swap 5 7) (swap 8 9) (swap 1 2) (swap 3 4) (swap 5 6) (swap 7 8) (swap 2 3) (swap 4 5) (swap 6 7))
                         (12 (swap 0 8) (swap 1 7) (swap 2 6) (swap 3 11) (swap 4 10) (swap 5 9) (swap 0 1) (swap 2 5) (swap 3 4) (swap 6 9) (swap 7 8) (swap 10 11) (swap 0 2) (swap 1 6) (swap 5 10) (swap 9 11) (swap 0 3) (swap 1 2) (swap 4 6) (swap 5 7) (swap 8 11) (swap 9 10) (swap 1 4) (swap 3 5) (swap 6 8) (swap 7 10) (swap 1 3) (swap 2 5) (swap 6 9) (swap 8 10) (swap 2 3) (swap 4 5) (swap 6 7) (swap 8 9) (swap 4 6) (swap 5 7) (swap 3 4) (swap 5 6) (swap 7 8))
                         (13 (swap 0 12) (swap 1 10) (swap 2 9) (swap 3 7) (swap 5 11) (swap 6 8) (swap 1 6) (swap 2 3) (swap 4 11) (swap 7 9) (swap 8 10) (swap 0 4) (swap 1 2) (swap 3 6) (swap 7 8) (swap 9 10) (swap 11 12) (swap 4 6) (swap 5 9) (swap 8 11) (swap 10 12) (swap 0 5) (swap 3 8) (swap 4 7) (swap 6 11) (swap 9 10) (swap 0 1) (swap 2 5) (swap 6 9) (swap 7 8) (swap 10 11) (swap 1 3) (swap 2 4) (swap 5 6) (swap 9 10) (swap 1 2) (swap 3 4) (swap 5 7) (swap 6 8) (swap 2 3) (swap 4 5) (swap 6 7) (swap 8 9) (swap 3 4) (swap 5 6))
                         (14 (swap 0 1) (swap 2 3) (swap 4 5) (swap 6 7) (swap 8 9) (swap 10 11) (swap 12 13) (swap 0 2) (swap 1 3) (swap 4 8) (swap 5 9) (swap 10 12) (swap 11 13) (swap 0 4) (swap 1 2) (swap 3 7) (swap 5 8) (swap 6 10) (swap 9 13) (swap 11 12) (swap 0 6) (swap 1 5) (swap 3 9) (swap 4 10) (swap 7 13) (swap 8 12) (swap 2 10) (swap 3 11) (swap 4 6) (swap 7 9) (swap 1 3) (swap 2 8) (swap 5 11) (swap 6 7) (swap 10 12) (swap 1 4) (swap 2 6) (swap 3 5) (swap 7 11) (swap 8 10) (swap 9 12) (swap 2 4) (swap 3 6) (swap 5 8) (swap 7 10) (swap 9 11) (swap 3 4) (swap 5 6) (swap 7 8) (swap 9 10) (swap 6 7))
                         (15 (swap 1 2) (swap 3 10) (swap 4 14) (swap 5 8) (swap 6 13) (swap 7 12) (swap 9 11) (swap 0 14) (swap 1 5) (swap 2 8) (swap 3 7) (swap 6 9) (swap 10 12) (swap 11 13) (swap 0 7) (swap 1 6) (swap 2 9) (swap 4 10) (swap 5 11) (swap 8 13) (swap 12 14) (swap 0 6) (swap 2 4) (swap 3 5) (swap 7 11) (swap 8 10) (swap 9 12) (swap 13 14) (swap 0 3) (swap 1 2) (swap 4 7) (swap 5 9) (swap 6 8) (swap 10 11) (swap 12 13) (swap 0 1) (swap 2 3) (swap 4 6) (swap 7 9) (swap 10 12) (swap 11 13) (swap 1 2) (swap 3 5) (swap 8 10) (swap 11 12) (swap 3 4) (swap 5 6) (swap 7 8) (swap 9 10) (swap 2 3) (swap 4 5) (swap 6 7) (swap 8 9) (swap 10 11) (swap 5 6) (swap 7 8)))
                       (nreverse swaps))
                   ,@(cl-loop for i from 0 below (length forms)
                              collect (funcall (nth i setters) (nth i vars))))))
          (let ((vec (gensym)))
            `(let ((,vec (vector ,@getters)))
               (setq ,vec (cl-sort ,vec ,test))
               ,@(cl-loop for i from 0 below (length forms)
                   collect (funcall (nth i setters) `(svref ,vec ,i))))))))))

sortf.lisp

;; Reference: https://bertdobbelaere.github.io/sorting_networks.html
;; Verified for N <= 15

(defmacro sortf (test &rest forms &environment env)
  (let (5-tuples tmpvars exprs-for-tmpvars store-places write-forms load-forms)
    (setf 5-tuples
      (mapcar
       (lambda (form)
         (multiple-value-list
          (get-setf-expansion form env)))
       forms))
    (setf tmpvars (mapcan #'first 5-tuples)
          exprs-for-tmpvars (mapcan #'second 5-tuples)
          store-places (mapcar #'car (mapcar #'third 5-tuples))
          write-forms (mapcar #'fourth 5-tuples)
          load-forms (mapcar #'fifth 5-tuples))
    `(let (,@(mapcar #'list tmpvars exprs-for-tmpvars))
       ,(if (< (length forms) 16)
            (let (swaps)
              (labels ((swap (i j)
                         (push `(unless (funcall ,test
                                          ,(nth i store-places)
                                          ,(nth j store-places))
                                  (psetq ,(nth i store-places)
                                         ,(nth j store-places)
                                         ,(nth j store-places)
                                         ,(nth i store-places)))
                               swaps)))
                `(let ,(mapcar #'list store-places load-forms)
                   ,@(progn
                       (case (length forms)
                         ((0 1) nil)
                         (2  (swap 0 1))
                         (3  (swap 0 1) (swap 0 2) (swap 1 2))
                         (4  (swap 0 2) (swap 1 3) (swap 0 1) (swap 2 3) (swap 1 2))
                         (5  (swap 0 3) (swap 1 4) (swap 0 2) (swap 1 3) (swap 0 1) (swap 2 4) (swap 1 2) (swap 3 4) (swap 2 3))
                         (6  (swap 0 5) (swap 1 3) (swap 2 4) (swap 1 2) (swap 3 4) (swap 0 3) (swap 2 5) (swap 0 1) (swap 2 3) (swap 4 5) (swap 1 2) (swap 3 4))
                         (7  (swap 0 6) (swap 2 3) (swap 4 5) (swap 0 2) (swap 1 4) (swap 3 6) (swap 0 1) (swap 2 5) (swap 3 4) (swap 1 2) (swap 4 6) (swap 2 3) (swap 4 5) (swap 1 2) (swap 3 4) (swap 5 6))
                         (8  (swap 0 2) (swap 1 3) (swap 4 6) (swap 5 7) (swap 0 4) (swap 1 5) (swap 2 6) (swap 3 7) (swap 0 1) (swap 2 3) (swap 4 5) (swap 6 7) (swap 2 4) (swap 3 5) (swap 1 4) (swap 3 6) (swap 1 2) (swap 3 4) (swap 5 6))
                         (9  (swap 0 3) (swap 1 7) (swap 2 5) (swap 4 8) (swap 0 7) (swap 2 4) (swap 3 8) (swap 5 6) (swap 0 2) (swap 1 3) (swap 4 5) (swap 7 8) (swap 1 4) (swap 3 6) (swap 5 7) (swap 0 1) (swap 2 4) (swap 3 5) (swap 6 8) (swap 2 3) (swap 4 5) (swap 6 7) (swap 1 2) (swap 3 4) (swap 5 6))
                         (10 (swap 0 8) (swap 1 9) (swap 2 7) (swap 3 5) (swap 4 6) (swap 0 2) (swap 1 4) (swap 5 8) (swap 7 9) (swap 0 3) (swap 2 4) (swap 5 7) (swap 6 9) (swap 0 1) (swap 3 6) (swap 8 9) (swap 1 5) (swap 2 3) (swap 4 8) (swap 6 7) (swap 1 2) (swap 3 5) (swap 4 6) (swap 7 8) (swap 2 3) (swap 4 5) (swap 6 7) (swap 3 4) (swap 5 6))
                         (11 (swap 0 9) (swap 1 6) (swap 2 4) (swap 3 7) (swap 5 8) (swap 0 1) (swap 3 5) (swap 4 10) (swap 6 9) (swap 7 8) (swap 1 3) (swap 2 5) (swap 4 7) (swap 8 10) (swap 0 4) (swap 1 2) (swap 3 7) (swap 5 9) (swap 6 8) (swap 0 1) (swap 2 6) (swap 4 5) (swap 7 8) (swap 9 10) (swap 2 4) (swap 3 6) (swap 5 7) (swap 8 9) (swap 1 2) (swap 3 4) (swap 5 6) (swap 7 8) (swap 2 3) (swap 4 5) (swap 6 7))
                         (12 (swap 0 8) (swap 1 7) (swap 2 6) (swap 3 11) (swap 4 10) (swap 5 9) (swap 0 1) (swap 2 5) (swap 3 4) (swap 6 9) (swap 7 8) (swap 10 11) (swap 0 2) (swap 1 6) (swap 5 10) (swap 9 11) (swap 0 3) (swap 1 2) (swap 4 6) (swap 5 7) (swap 8 11) (swap 9 10) (swap 1 4) (swap 3 5) (swap 6 8) (swap 7 10) (swap 1 3) (swap 2 5) (swap 6 9) (swap 8 10) (swap 2 3) (swap 4 5) (swap 6 7) (swap 8 9) (swap 4 6) (swap 5 7) (swap 3 4) (swap 5 6) (swap 7 8))
                         (13 (swap 0 12) (swap 1 10) (swap 2 9) (swap 3 7) (swap 5 11) (swap 6 8) (swap 1 6) (swap 2 3) (swap 4 11) (swap 7 9) (swap 8 10) (swap 0 4) (swap 1 2) (swap 3 6) (swap 7 8) (swap 9 10) (swap 11 12) (swap 4 6) (swap 5 9) (swap 8 11) (swap 10 12) (swap 0 5) (swap 3 8) (swap 4 7) (swap 6 11) (swap 9 10) (swap 0 1) (swap 2 5) (swap 6 9) (swap 7 8) (swap 10 11) (swap 1 3) (swap 2 4) (swap 5 6) (swap 9 10) (swap 1 2) (swap 3 4) (swap 5 7) (swap 6 8) (swap 2 3) (swap 4 5) (swap 6 7) (swap 8 9) (swap 3 4) (swap 5 6))
                         (14 (swap 0 1) (swap 2 3) (swap 4 5) (swap 6 7) (swap 8 9) (swap 10 11) (swap 12 13) (swap 0 2) (swap 1 3) (swap 4 8) (swap 5 9) (swap 10 12) (swap 11 13) (swap 0 4) (swap 1 2) (swap 3 7) (swap 5 8) (swap 6 10) (swap 9 13) (swap 11 12) (swap 0 6) (swap 1 5) (swap 3 9) (swap 4 10) (swap 7 13) (swap 8 12) (swap 2 10) (swap 3 11) (swap 4 6) (swap 7 9) (swap 1 3) (swap 2 8) (swap 5 11) (swap 6 7) (swap 10 12) (swap 1 4) (swap 2 6) (swap 3 5) (swap 7 11) (swap 8 10) (swap 9 12) (swap 2 4) (swap 3 6) (swap 5 8) (swap 7 10) (swap 9 11) (swap 3 4) (swap 5 6) (swap 7 8) (swap 9 10) (swap 6 7))
                         (15 (swap 1 2) (swap 3 10) (swap 4 14) (swap 5 8) (swap 6 13) (swap 7 12) (swap 9 11) (swap 0 14) (swap 1 5) (swap 2 8) (swap 3 7) (swap 6 9) (swap 10 12) (swap 11 13) (swap 0 7) (swap 1 6) (swap 2 9) (swap 4 10) (swap 5 11) (swap 8 13) (swap 12 14) (swap 0 6) (swap 2 4) (swap 3 5) (swap 7 11) (swap 8 10) (swap 9 12) (swap 13 14) (swap 0 3) (swap 1 2) (swap 4 7) (swap 5 9) (swap 6 8) (swap 10 11) (swap 12 13) (swap 0 1) (swap 2 3) (swap 4 6) (swap 7 9) (swap 10 12) (swap 11 13) (swap 1 2) (swap 3 5) (swap 8 10) (swap 11 12) (swap 3 4) (swap 5 6) (swap 7 8) (swap 9 10) (swap 2 3) (swap 4 5) (swap 6 7) (swap 8 9) (swap 10 11) (swap 5 6) (swap 7 8)))
                       (nreverse swaps))
                   ,@write-forms)))
            (let ((arr (gensym)))
              `(let ((,arr (vector ,@load-forms)))
                 (declare (dynamic-extent ,arr))
                 (sort ,arr ,test)
                 (let ,(loop for i from 0 below (length forms)
                             collect `(,(nth i store-places)
                                        (aref ,arr ,i)))
                   ,@write-forms)))))))