Найти все циклы графа в виде списка списков вершин с точностью до начальной вершины

;; найти первую вершину, связанную с v и непосещенную
 
(defun search (v graph chk)  
  (dolist (i graph nil)
    (when (and (eq v (car i)) (not (member (cadr i) chk))) (return (cadr i)))
    (when (and (eq v (cadr i)) (not (member (car i) chk))) (return (car i)))))
 
;; Проверка циклов
 
(defun chk-loop (stack graph)
  (if (null (cddr stack)) nil
      (let* ((b (car stack)) (c 2))
            (dolist (i (cddr stack) nil)
              (when (is-bound graph i b) (printline (subseq stack 0 (+ 1 c))))
              (setq c (+ 1 c))))))
 
;; Проверка смежности вершин              
              
(defun is-bound (graph v1 v2)
  (or (member (list v1 v2) graph) (member (list v1 v2) graph)))
 
;; Обход в глубину
  
(defun dfs! (graph &optional (chk '(1)) (stack '(1)))
  (let ((w (if (null stack) nil (search (car stack) graph chk))))
       (cond ((and (null w) (null stack)) nil)
             ((null w) (dfs! graph chk (cdr stack)))
             (t (chk-loop (cons w stack) graph) 
                (cons (list (car stack) w) (dfs! graph (cons w chk) (cons w stack))))))) 
 
;; Запускающая программа
 
(defun dfs (graph v)
  (dfs! graph (list v) (list v)))
 
;; Запуск
 
(dfs '((a b) (a d) (a h) (a g) (b c) (c h) (d e) (e f) (f h) (g h)) 'a)
(h c b a)         ;; фунд. цикл
(d e f h c b a)  ;; фунд. цикл
(g h c b a)       ;; фунд. цикл
 
==> ((a b) (b c) (c h) (h f) (f e) (e d) (h g)) ;; каркас графа