Plaster

common-lisp
(defun compose-sorting-predicates (predicate &rest more-predicates) (if (null more-predicates) predicate (let ((later< (apply #'compose-sorting-predicates more-predicates))) (lambda (a b) (cond ((funcall predicate a b) t) ((funcall predicate b a) nil) (t (funcall later< a b))))))) (defparameter *l* (list (cons 1 2) (cons 0 4) (cons 1 0) (cons 1 4) (cons 5 0) (cons 3 4))) (defun car< (a b) (< (car a) (car b))) (defun cdr< (a b) (< (cdr a) (cdr b))) (print (sort (copy-list *l*) (compose-sorting-predicates #'car< #'cdr<))) (defun keypose (function key) (lambda (&rest args) (apply function (mapcar key args)))) (defun keypose2 (function key) (lambda (a b) (funcall function (funcall key a) (funcall key b)))) (print (sort (copy-list *l*) (compose-sorting-predicates (keypose #'< #'cdr) (keypose #'< #'car)))) (defpackage a (:export :a :b :c)) (defpackage b (:export :a :b :c)) (print (sort (list 'a:a 'b:b 'a:c 'b:a) (compose-sorting-predicates (keypose2 #'string< (alexandria:compose #'package-name #'symbol-package)) (keypose2 #'string< #'symbol-name))))