Recursion CLISP dfs获取程序堆栈溢出

我是Lisp新手，我正在尝试使用简单的dfs（深度优先搜索）解决一个8字难题。 但是我得到了一个程序堆栈溢出。 我的代码：

(setq used (list))

(defun is_used (state lst) 
  (cond
    ((null lst)   nil)
    ((equalp (car lst) state)   t) 
    (t   (is_used state (cdr lst)))))

(defun move (lst direction)
  (let* ( (zero (find_zero lst)) 
          (row  (floor zero 3)) 
          (col  (mod zero 3)) 
          (res  (copy-list lst)))
     (cond
        ((eq direction 'L) 
           (if (> col 0) 
               (rotatef (elt res zero) (elt res (- zero 1)))))
        ((eq direction 'R) 
           (if (< col 2) 
               (rotatef (elt res zero) (elt res (+ zero 1)))))
        ((eq direction 'U) 
           (if (> row 0) 
               (rotatef (elt res zero) (elt res (- zero 3)))))
        ((eq direction 'D) 
           (if (< row 2) 
               (rotatef (elt res zero) (elt res (+ zero 3))))))
     (if (equalp res lst) 
         (return-from move nil))
     (return-from move res))
  nil)

(defun dfs (cur d prev)
  ; (write (length used))
  ; (terpri)
  (push cur used)
  (let* ((ways '(L R U D)))
    (loop for dir in ways
          do (if (move cur dir)
                 (if (not (is_used (move cur dir) used))
                     (dfs (move cur dir) (+ d 1) cur))))))

（使用setq（列表））
（已使用defun（状态lst）
（续）
（（空lst）无）
（（相等（轿厢lst）状态）t）
（t（正在使用状态（cdr lst()()))）
（卸载移动（lst方向）
（让*（（零（找到零）
（世界其他地区（第三层））
（col（国防部零3级））
（副本列表lst）
（续）
（（eq方向'L）
（如果（>列0）
（旋转（elt res零）（elt res（-0 1(()))）
（（均衡器方向'R）
（如果（第0行）
（旋转（elt res zero）（elt res（-zero 3(()))）
（（等式方向'D）
（如果（<第2行）
（旋转速度（英语教学速度为零）（英语教学速度（+0 3()())))
（如果（同等条件下）
（从移动返回零）
（从移动res返回）
零）
（取消dfs（当前和上一版本）
（书写（使用长度））
(i)
（使用推送电流）
（让*（（方式）（L R U D）））
（以多种方式循环dir
do（如果（移动当前方向）
（如果（未使用（移动当前方向））
（dfs（移动当前目录）（+d 1）当前()()()))）

state

这里是9个原子的列表

使用未注释的

（write（使用的长度））

在堆栈溢出发生之前，它将打印723-使用的

中的项数

现在，在解决8字谜之前，我只想迭代所有可能的状态（总共有9！/2=181440个可能的状态）。当然，这可能需要一些时间，但是如何避免堆栈溢出呢？
这是一些AI编程书籍中解释的典型问题。如果需要搜索大量/无限的状态，则不应使用递归。CL中的递归受堆栈深度的限制。有些实现可以优化尾部递归，但是您需要构建代码的体系结构，以便它是尾部递归的

通常，该项目的数据结构称为议程。它使各州仍有待探索。如果你看一个州，你会把所有州都推到议事日程上。确保议程以某种方式排序（这可能决定是深度优先还是广度优先）。然后从议程中选择下一个状态并检查它。如果目标实现了，那么你就完成了。如果在找到目标之前议程是空的，那么就没有解决方案。否则循环…
您的代码将被简化

(setq *used* (list))

(defun move (position direction)
  (let* ( (zero (position 0 position)) 
          (row  (floor zero 3)) 
          (col  (mod   zero 3)) 
          (command (find direction `((L ,(> col 0) ,(- zero 1))
                                     (R ,(< col 2) ,(+ zero 1))
                                     (U ,(> row 0) ,(- zero 3))
                                     (D ,(< row 2) ,(+ zero 3)))
                         :key #'car)))
     (if (cadr command)
        (let ((res (copy-list position)))
           (rotatef (elt res zero) (elt res (caddr command)))
           res))))

(defun dfs-rec (cur_pos depth prev_pos)
  (write (length *used*)) (write '_) (write depth) (write '--)
  ; (terpri)
  (push cur_pos *used*)
  (let* ((dirs '(L R U D)))
    (loop for dir in dirs
          do (let ((new_pos (move cur_pos dir)))
               (if (and new_pos
                        (not (member new_pos *used* :test #'equalp)))
                 (dfs-rec new_pos (+ depth 1) cur_pos))))))

(print (dfs-rec '(0 1 2 3 4 5 6 7 8) 0 '()))

这样一来，就没有更多的信息需要跟踪了，递归——它们都在
待办事项
列表中

这意味着生成的位置将按后进先出顺序处理，即
待办事项
列表将用作堆栈，实现深度优先搜索策略

如果您将所有新位置附加到
待办事项
列表末尾的每个步骤上，这意味着它将被用作一个队列，以FIFO顺序，实现广度优先搜索。
移动的定义是什么？@sylvester我已将移动功能添加到给定的代码中
(defun new-positions (position)
  (let* ( (zero (position 0 position)) 
          (row  (floor zero 3)) 
          (col  (mod   zero 3)) )
    (mapcan
         #'(lambda (command)
             (if (cadr command)
               (let ((res (copy-list position)))
                  (rotatef (elt res zero) (elt res (caddr command)))
                  (list res)))) 
         `((L ,(> col 0) ,(- zero 1))
           (R ,(< col 2) ,(+ zero 1))
           (U ,(> row 0) ,(- zero 3))
           (D ,(< row 2) ,(+ zero 3))) ))) 

; non-recursive dfs function skeleton
(defun dfs (start-pos &aux to-do curr new)
   (setf to-do (list start-pos))
   (loop while to-do
      do (progn (setf curr (pop to-do))
                (setf new (new-positions curr))
                (setf to-do (nconc new to-do)))))