Пожалуйста, подправьте программку! Списки списков (Allegro lisp)

; подсчет количества подсписков в исх. списке
(defun podschet (w)
   (setq i 1)
(cond   (if (= w null) i)
        (podschet (cdr w)))
   (setq i (+ i 1))
(return from podschet i))   
;------------------------------------------- 
          (setq mylst '((a 2) (n  6) (a v) (7  n) (d a)))
(loop for i from 1 to i do
  (setq cep '())                             
  (setq golova (car mylst))               
  (setq hvost (cdr mylst))
  (setq iskom_el (cdr golova))            ; искомый элемент - хвост первого подсписка
    (if (= iskom_el (car (car hvost)))    ; сравниваем искомый элемент с первым эл-том первого подсписка хвоста
      (cons cep (car hvost) )
      (setq mylst hvost)                     ; отсекаем голову заданного списка
     )
)
(podschet mylst)

;; Построить из списка lst цепочку с "затравкой" curr
 
(defun mk-chain (lst curr &optional (chain (list curr)))
  (cond ((null lst) chain)
        ((eq (cadr curr) (caar lst)) (mk-chain (cdr lst) (car lst) (append chain (list (car lst)))))
        (t (mk-chain (cdr lst) curr chain))))
 
;; Решение задачи:
 
(defun task (lst)
  (let ((res nil))
    (dolist (i lst res)
      (let ((ch (mk-chain lst i)))
        (when (> (length ch) 1) (push ch res))))))   
 
==> task
 
(task '((a 2) (n 6) (2 f) (a v) (6 b) (f p) (d a)))
 
==> (((d a) (a 2) (2 f) (f p)) ((2 f) (f p)) ((n 6) (6 b)) ((a 2) (2 f) (f p)))

(defun del (v w)
  (cond ((null w) nil)
        ((equal (car w) v) (del v (cdr w)))
        ((cons (car w) (del v (cdr w))))))
 
(defun chains (w z)
  (when w (cons (chain w z) (chains (cdr w) z))))
 
(defun chain (w z &optional (b (car w)) &aux (v (same b z)))
  (if v (cons b (chain (cdr w) (del b (del v z)) v)) `(,b)))
       
(defun same (v w)
  (cond ((null w) nil)
        ((eq (cadr v) (caar w)) (car w))
        ((same v (cdr w)))))
 
(defun all-chains (w)
  (delete-if-not #'cdr (chains w w)))
 
> (all-chains '((a 2) (n 6) (2 f) (a v) (6 b) (f p) (d a)))
(((A 2) (2 F) (F P)) ((N 6) (6 B)) ((2 F) (F P)) ((D A) (A 2) (2 F) (F P)))

(defun del (v w)
  (cond ((null w) nil)
        ((equal (car w) v) (del v (cdr w)))
        ((cons (car w) (del v (cdr w))))))
 
(defun chains (w z &aux (c (chain w z)))
  (when w (if (cdr c)
              (cons c (chains (cdr w) z))
              (chains (cdr w) z))))
 
(defun chain (w z &optional (b (car w)) &aux (v (same b z)))
  (if v (cons b (chain (cdr w) (del b (del v z)) v)) `(,b)))
       
(defun same (v w)
  (cond ((null w) nil)
        ((eq (cadr v) (caar w)) (car w))
        ((same v (cdr w)))))
 
(defun all-chains (w)
  (chains w w))
 
> (all-chains '((a 2) (n 6) (2 f) (a v) (6 b) (f p) (d a)))
(((A 2) (2 F) (F P)) ((N 6) (6 B)) ((2 F) (F P)) ((D A) (A 2) (2 F) (F P)))

(defun del (v w)
  (cond ((null w) nil)
        ((equal (car w) v) (del v (cdr w)))
        ((cons (car w) (del v (cdr w))))))
 
(defun chains (w z)
  (when w (cons (chain w z) (chains (cdr w) z))))
 
(defun clear (v w)
  (cond ((null v) nil)
        ((some #'(lambda (e) (subsetp (car v) e :test #'equalp))
               (remove (car v) w))
         (clear (cdr v) w))
        ((cons (car v) (clear (cdr v) w)))))
 
(defun chain (w z &optional (b (car w)) &aux (v (same b z)))
  (if v (cons b (chain (cdr w) (del b (del v z)) v)) `(,b)))
       
(defun same (v w)
  (cond ((null w) nil)
        ((eq (cadr v) (caar w)) (car w))
        ((same v (cdr w)))))
 
(defun all-chains (w &aux (z (chains w w)))
  (delete-if-not #'cdr (clear z z)))
 
> (all-chains '((a 2) (n 6) (2 f) (a v) (6 b) (f p) (d a)))
(((N 6) (6 B)) ((D A) (A 2) (2 F) (F P)))

(defun chains (w z)
  (when w (cons (chain w z) (chains (cdr w) z))))
 
(defun clear (v w)
  (cond ((null v) nil)
        ((some #'(lambda (e) (subsetp (car v) e :test #'equal))
               (remove (car v) w))
         (clear (cdr v) w))
        ((cons (car v) (clear (cdr v) w)))))
 
(defun chain (w z &optional (b (car w)) &aux (v (same b z)))
  (if v (cons b (chain (cdr w) (remove b (remove v z)) v)) `(,b)))
       
(defun same (v w)
  (cond ((null w) nil)
        ((eq (cadr v) (caar w)) (car w))
        ((same v (cdr w)))))
 
(defun all-chains (w &aux (z (chains w w)))
  (delete-if-not #'cdr (clear z z)))
 
> (all-chains '((a 2) (n 6) (2 f) (a v) (6 b) (f p) (d a)))
(((N 6) (6 B)) ((D A) (A 2) (2 F) (F P)))

(defun task (lst)
  (let ((res nil))
   (loop
    (when (not
     (dolist (i lst nil)
       (when (let ((ch (mk-chain lst i)))
               (when (> (length ch) 1) 
                     (push ch res)
                     (dolist (j ch t)
                        (setq lst (removef j lst)))
                     t) nil) (return t)  ))) (return res)))))
 
(task '((a 2) (n 6) (2 f) (a v) (6 b) (f p) (d a)))
 
==> (((d a) (a v)) ((n 6) (6 b)) ((a 2) (2 f) (f p)))

((D A) (A 2) (2 F) (F P))