Destructive quick and merge sort

Question

I've implemented a destructive merge and quick sort in common lisp, but the code feels verbose and highly imperative. I was wondering if anyone could offer guidance on idioms that could make the code more readable, or more lispy. Any other criticism and advice is also welcome.

I chose to make these functions destructive because, if I understand correctly, common lisp's built in sort function is destructive.

(defmacro insert-after (to-move pos)
 "Moves the cons cell 'to-move' so that it appears after 'pos'"
 `(progn
 (setf (cdr ,to-move) (cdr ,pos))
 (setf (cdr ,pos) ,to-move)))
(defun quick-sort (seq comparator)
 "Destructive quick-sort for cons-based lists."
 (cond
 ((not seq) nil)
 (t
 (let ((left-head (cons nil nil))
 (right-head (cons nil nil))
 (middle-head (cons nil nil))
 (pivot (first seq)))
 (do ((next (cdr seq) (cdr next))
 (pos seq next))
 ((not pos))
 (cond
 ((equal pivot (car pos)) (insert-after pos middle-head))
 ((funcall comparator (car pos) pivot) (insert-after pos left-head))
 (t (insert-after pos right-head))))
 (append (quick-sort (cdr left-head) comparator)
 (cdr middle-head)
 (quick-sort (cdr right-head) comparator))))))
(defun merge-cons (left right comparator)
 "Merge two sorted lists and return the sorted, merged list."
 (do* ((head (cons nil left))
 (prev-left head))
 ((not right) (cdr head))
 (cond
 ;; If we walk off the end of left, attach right to the end and return
 ((not left)
 (setf (cdr prev-left) right)
 (setf right nil))
 ;; If left takes priority, keep walking along the left list
 ((funcall comparator (car left) (car right))
 (setf prev-left left)
 (setf left (cdr left)))
 ;; If right takes priority, Insert the head of right into left and cont.
 (t
 (setf (cdr prev-left) right)
 (setf right (cdr right))
 (setf (cddr prev-left) left)
 (setf prev-left (cdr prev-left))))))
(defun merge-sort (seq comparator)
 "Destructive merge-sort for cons-based lists."
 (let* ((partition (ceiling (length seq) 2))
 (left-end
 ;; i=1 and not 0 so that left-end's cdr is the start of the
 ;; right partition.
 (do ((i 1 (1+ i))
 (left-end seq (cdr left-end)))
 ((>= i partition) left-end)))
 (right (cdr left-end)))
 (setf (cdr left-end) nil)
 (cond
 ((not right) seq)
 (t (merge-cons (merge-sort seq comparator)
 (merge-sort right comparator)
 comparator)))))

Example of how to use these functions:

CL-USER> (merge-sort '(3 1 2 4 5 0) #'<)
(0 1 2 3 4 5)
CL-USER> (quick-sort '(3 1 2 4 5 0) #'<)
(0 1 2 3 4 5)

• Ehvince: sort is destructive indeed. A trick is to do (sort (copy-list ...))
• Ehvince: Why is insert-after a macro?
• bfair: @Ehvince, I made insert-after a macro because I wanted a shorthand way to write the two lines in the body of the macro, while it also didn't seem necessary for the program to create a whole new stack frame just to do what that macro does. I guess I was using it for the same reason why someone would write an inline function in C. Is that a bad reason?
• Ehvince: Yeah I think so: the general rule of thumb is to not write a macro if it can be a function. And for your goal (premature optimization?) see (declare (inline insert-after)). lispworks.com/documentation/HyperSpec/Body/d_inline.htm & lispcookbook.github.io/cl-cookbook/performance.html#code-inline