更合适的Common Lisp抽象，以实现“自递归让”

Question

昨天，我遇到了常见的Lisp pipes库。它在某种程度上看起来很像clojure的惰性序列抽象，所以我决定用它来实现Common Lisp中递归惰性Fibonacci序列定义的经典（和经典）clojure示例（纯粹出于教育目的）。

这就是Clojure中的样子：

(def fibs (lazy-cat [0 1] (map +' fibs (rest fibs))))

(nth fibs 100)
;;=> 354224848179261915075N

这很简单，但是问题是它可能在全球范围内永远保持巨大的惰性序列，因此我用一些技巧重写了它，以便可以在let绑定内使用：

(let [f (memoize (fn [f] 
                   (lazy-cat [0 1] 
                             (let [data (f f)]
                               (map +' data (rest data))))))
      fibs (f f)]
  (nth fibs 100))

;;=> 354224848179261915075N

整个memoize和(f f)都是在let中模拟数据递归。

然后我在CL中使用相同的方法实现了它。

首先，一些实用程序：

;; analogue of `list*` for pipes
(defmacro make-pipe* (x1 &rest xs)
  (if xs
      `(pipes:make-pipe ,x1 (make-pipe* ,@xs))
      x1))

;; wraps function so that it always returns the result of its first invocation
(defun once (f)
  (let ((called (cons nil nil)))
    (lambda (&rest args)
      (if (car called)
          (cdr called)
          (let ((res (apply f args)))
            (setf called (cons t res))
            res)))))

;; map over two pipes
(defun pipe-map2 (fn pipe1 pipe2)
  (if (or (eq pipe1 pipes:+empty-pipe+)
          (eq pipe2 pipes:+empty-pipe+))
      pipes:+empty-pipe+
      (pipes:make-pipe (funcall fn (pipes:pipe-head pipe1) (pipes:pipe-head pipe2))
                       (pipe-map2 fn (pipes:pipe-tail pipe1) (pipes:pipe-tail pipe2)))))

然后是实际的实现：

(let* ((f (once (lambda (f) 
                  (make-pipe* 0 1 
                              (let ((data (funcall f f)))
                                (pipe-map2 #'+ data (pipes:pipe-tail data)))))))
       (fibs (funcall f f)))
  (pipes:pipe-values fibs 10))
;;=> (0 1 1 2 3 5 8 13 21 34 55 . #<CLOSURE (LAMBDA () :IN PIPE-MAP2) {10096C6BBB}>)

好。有用。但是问题是：由于通用的Lisp提供的元编程和编译控制实用程序比clojure丰富得多，是否有任何合适的实用程序可以使“自我递归让”（如我所说的）更加优雅，从而消除了使用已记录的丑陋骇客的需要函数调用，最好避免发生可变状态（尽管我不确定是否完全可能）？

Answer 1

冥想后，我得到了这个解决方案：

(defmacro letr ((name val) &body body)
  (let ((f-name (gensym)))
    `(let ((,name (symbol-macrolet ((,name (funcall ,f-name ,f-name)))
                    (let* ((,f-name (once (lambda (,f-name) ,val))))
                      ,name))))
       ,@body)))

实际上是通过symbol-macrolet重写初始解的方法

可以使用这种方式：

CL-USER> (letr (fibs (make-pipe* 0 1 (pipe-map2 #'+ fibs (pipes:pipe-tail fibs))))
           (pipes:pipe-values fibs 10))
;;=> (0 1 1 2 3 5 8 13 21 34 55 . #<CLOSURE (LAMBDA () :IN PIPE-MAP2) {1001D3FCBB}>)

它被扩展为这个：

(LET ((FIBS
       (SYMBOL-MACROLET ((FIBS (FUNCALL #:G596 #:G596)))
         (LET* ((#:G596
                 (ONCE
                  (LAMBDA (#:G596)
                    (CONS 0
                          #'(LAMBDA ()
                              (CONS 1
                                    #'(LAMBDA ()
                                        (PIPE-MAP2 #'+ (FUNCALL #:G596 #:G596)
                                                   (PIPES:PIPE-TAIL
                                                    (FUNCALL #:G596
                                                             #:G596)))))))))))
           (FUNCALL #:G596 #:G596)))))
  (PIPES:PIPE-VALUES FIBS 10))

，当然，仅在这种情况下，递归(funcall f f)被延迟，只能在相当狭窄的领域中使用。否则，它将导致无限的复活，从而导致堆栈向上流动。 （尽管我很确定它仍然可以通过某种方式进行改进）

Answer 2

如果您有一个带有2个参数的递归函数，则必须具有一个像[f arg1 arg2]这样的特征，然后使用您的解决方案就必须像这个(f f arg1 arg2)那样递归。如果您使用辅助函数和volatile，可以使事情更短：

(defn memo [f]
  (let [v (volatile! nil)]
    (vreset! v (memoize (fn [& args] (apply f @v args))))))

所以您现在可以做：

(let [f (memo (fn [this arg1 arg2] (this arg1 arg2)))] (f arg1 arg2))

因此使递归调用1参数更短，也就是说，不必调用(f f)，而只需调用(f)。

Answer 3

我认为您过于复杂了。您只需要]

(defun mk-fibs ()
  (let (q)
     (setf q (make-pipe* 0 1 
               (pipe-map2 #'+ q 
                              (pipes:pipe-tail q))))))

立刻

制作多个相互引用数据递归定义”对于这种方法也是微不足道的。当然，您可以将其编码为具有更常规语法结构的宏，

    (letrec ((p ...)
             (q ...)
             (r ...) ...)
       body ...)
==
    (destructuring-bind (p q r ...)
            (let ((p) (q) (r) ...)
               (setf p ...)
               (setf q ...)
               (setf r ...) ...
               (list p q r ...))
       body ...)

概念证明，在CLISP中（使用一些自定义的备忘delay实现，并在此之上构建流）：

delay[22]: (defun mk-fibs ()
   (let (q)
      (setf q (scons 0 (scons 1 
                  (sadd q (stail q 1)))))))

delay[23]: (sitems (mk-fibs) 1 10)
(1 1 2 3 5 8 13 21 34 55)

delay[28]: (destructuring-bind (q) (let (q) 
                   (setf q (scons 0 (scons 1
                      (sadd q (stail q 1))))) (list q)) 
   (sitems q 0 11))
(0 1 1 2 3 5 8 13 21 34 55)