recursion - 更适合Common Lisp抽象来实现 "self recursive let"

Question

昨天我遇到了这个pipes Common Lisp 库。它在某种程度上看起来很像 clojure 的惰性序列抽象，因此我决定使用它来实现 Common Lisp 中递归惰性斐波那契序列定义的经典(且优雅)的 clojure 示例(纯粹出于教育目的)。

这就是 clojure 中的样子:

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

(nth fibs 100)
;;=> 354224848179261915075N

这非常简单，但问题是它永远在全局范围内保留可能巨大的惰性序列，因此通过一些技巧我重写了它，以便它可以在 let 绑定(bind)中使用:

(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 和 (ff) 就是在 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}>)

好的。有用。但问题是:由于 common lisp 提供了比 clojure 更多的元编程和编译控制实用程序，是否有任何合适的工具可以使“自递归 let”(我这样调用它)更优雅，从而消除使用 memoized 进行丑陋 hack 的需要函数调用，最好避免可变状态(尽管我不确定这是否可能)？

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) 被延迟，就像在本例中一样。否则会导致无限递归导致堆栈溢出。 (虽然我很确定它仍然可以以某种方式改进)