Список атомов. Написать программу, возвращающую список заданного вида

;; подсчет числа вхождений атома в список
 
(defun cou (e lst)
  (cond ((null lst) 0)
        ((EQ e (car lst)) (+ 1 (cou e (cdr lst))))
        (t (cou e (cdr lst)))))
 
 
==> cou
 
(cou 1 '(1 2 1 2 3 1))
 
==> 3
 
;; построение пар ((атом число-вхождений))
 
(defun mkpair (x)
  (cond ((null x) nil)
        (t (cons (list (car x) (cou (car x) x)) (mkpair (remove (car x) x))))))
 
 
==> mkpair
 
(mkpair '(a b c a b c d))
 
==> ((a 2) (b 2) (c 2) (d 1))
 
;; сортировка списка пар
 
(defun msort (x) (COND ((NULL x) NIL) 
    (T (APPEND (msort (remove-if (FUNCTION (LAMBDA (z) (> (cadr z) (CADAR x)))) (CDR x))) 
               (LIST (CAR x)) 
               (msort (remove-if (FUNCTION (LAMBDA (z) (<= (cadr z) (CADAR x)))) (CDR x)))))))
 
==> msort
 
(msort '((a 2) (b 2) (c 2) (d 1)))
 
 
==> ((d 1) (c 2) (b 2) (a 2))
 
;; объединение 
 
(defun merge (x &optional r)
  (cond ((null x) nil)
        ((= (length x) 1)
         (cond (r (append (list r) (list (caar x))))
               (t (list (caar x))) 
        ))
        ((= (cadar x) (cadadr x)) (merge (cdr x) (cons (caar x) r)))
        (r (append (list (cons (caar x) r)) (merge (cdr x) nil)))
        (t (append (list (caar x)) (merge (cdr x) nil)))))
 
==> merge
 
(merge '((a 2) (b 2) (c 2) (d 1)))
 
==> ((c b a) d)
 
;; Решение задачи
 
(defun task (x)
   (merge (msort (mkpair x))))
 
==> task
 
(task '(a b c a b c d e f h h h))
 
==> ((d e f) (a b c) h)

(PACKAGE-LOCK-VIOLATION #<PACKAGE "COMMON-LISP"> :SYMBOL MERGE :FORMAT-CONTROL "setting fdefinition of ~A" :FORMAT-ARGUMENTS (MERGE))
0]

(defun merge (lst &optional (r nil) (p nil) (z nil))
   (cond ((null lst) (append r (list (append z (list (car p))))))
         ((null p) (merge (cdr lst) r (car lst) nil)) 
         ((= (cadr p) (cadar lst)) (merge (cdr lst) r (car lst) (cons (car p) z)))
         (t (if (null z) (merge (cdr lst) (append r (list (car p))) (car lst) nil)
                         (merge (cdr lst) (append r (list (cons (car p) z))) (car lst) nil)))))
 
(defun finish (lst)
  (mapcar #'(lambda (x) (cond ((atom x) x)
                              ((null (cdr x)) (car x))
                              (t x))) lst))
 
(defun task (x)
  (finish (merge (msort (mkpair x)))))
 
 
 (task '(A A B B C C D E))
 
==> ((d e) (b c a))
 
(task '(a b c a b c d e f h h h))
 
==> ((d e f) (a b c) h)

(defun msort (x) (COND ((NULL x) NIL) 
    (T (APPEND (msort (remove-if (FUNCTION (LAMBDA (z) (> (cadr z) (CADAR x)))) (CDR x))) 
               (LIST (CAR x)) 
               (msort (remove-if (FUNCTION (LAMBDA (z) (<= (cadr z) (CADAR x)))) (CDR x)))))))