История изменений

(defmacro multiple-less ((&optional (a (gensym "A"))
                                    (b (gensym "B")))
                         &body clauses)
  (let ((original-a (gensym "A"))
        (original-b (gensym "B")))
    (labels ((less (clauses)
               (destructuring-bind (form &optional (key #'identity)) (pop clauses)
                 (when (atom form) (setf form `(,form ,a ,b)))
                 `(let ((,a (funcall ,key ,original-a))
                        (,b (funcall ,key ,original-b)))
                    ,(if clauses
                       `(cond
                          (,form
                            t)
                          ((let ((,a ,b) (,b ,a))
                             ,form)
                           nil)
                          (t
                            ,(less clauses)))
                       form)))))
      (if clauses
        `(lambda (,original-a ,original-b)
           ,(less clauses))
        (constantly t)))))

(defclass mytype1 () ())
(defclass mytype2 () ())

(defstruct s
  (a 0                        :type integer)
  (b 0.0                      :type float)
  (c (make-instance 'mytype1) :type mytype1)
  (d (make-instance 'mytype2) :type mytype2)
  (e ""                       :type string))

; 1) по a, c,e используя стандартные компараторы. 
(multiple-less ()
  (<       #'s-a)
  (less    #'s-c)
  (string< #'s-e))

; 2) по c, e используя кастомный (нестандартный итератор только для поля c)
(multiple-less (a b)
  ((compare-somehow a b) #'s-c) ; вместо (compare-somehow a b) --- произвольный код
  (string<               #'s-e))

; 3) по с, е использую нестандартные компораторы (для e пусть будет апер кейс)
(multiple-less ()
  (compare-somehow2 #'s-с) ; если уже есть определённая ранее функция compare-somehow
  (string<          (lambda (s) (string-upcase (s-e s)))))

; 4) по c, d, e для c и e стандартный, для d свой. 
(multiple-less (a b)
  (less #'s-c)
  ((or (< (key1 a) (key2 b)) ; ну например, произвольный код
       (mytype2< a b))
   #'s-d)
  (string< #'s-e))

(defmacro multiple-less ((&optional (a (gensym "A"))
                                    (b (gensym "B")))
                         &body clauses)
  (let ((original-a (gensym "A"))
        (original-b (gensym "B")))
    (labels ((less (clauses)
               (destructuring-bind (form &optional (key #'identity)) (pop clauses)
                 (when (atom form) (setf form `(,form ,a ,b)))
                 `(let ((,a (funcall ,key ,original-a))
                        (,b (funcall ,key ,original-b)))
                    ,(if clauses
                       `(cond
                          (,form
                            t)
                          ((let ((,a ,b) (,b ,a))
                             ,form)
                           nil)
                          (t
                            ,(less clauses)))
                       form)))))
      (if clauses
        `(lambda (,original-a ,original-b)
           ,(less clauses))
        (constantly t)))))

(defclass mytype1 () ())
(defclass mytype2 () ())

(defstruct s
  (a 0                        :type integer)
  (b 0.0                      :type float)
  (c (make-instance 'mytype1) :type mytype1)
  (d (make-instance 'mytype2) :type mytype2)
  (e ""                       :type string))

; 1) по a, c,e используя стандартные компараторы. 
(multiple-less ()
  (<       #'s-a)
  (less    #'s-c)
  (string< #'s-e))

; 2) по c, e используя кастомный (нестандартный итератор только для поля c)
(multiple-less (a b)
  ((compare-somehow a b) #'s-c) ; вместо (compare-somehow a b) --- произвольный код
  (string<               #'s-e))

; 3) по с, е использую нестандартные компораторы (для e пусть будет апер кейс)
(multiple-less ()
  (compare-somehow2 #'s-a) ; если уже есть определённая ранее функция compare-somehow
  (string<          (lambda (s) (string-upcase (s-e s)))))

; 4) по c, d, e для c и e стандартный, для d свой. 
(multiple-less (a b)
  (less #'s-c)
  ((or (< (key1 a) (key2 b)) ; ну например, произвольный код
       (mytype2< a b))
   #'s-d)
  (string< #'s-e))