更适合实现“自递归 let”的 Common Lisp 抽象答案

【问题标题】：More suitable Common Lisp abstraction to implement "self recursive let"更适合实现“自递归 let”的 Common Lisp 抽象
【发布时间】：2020-02-19 20:45:00
【问题描述】：

昨天我遇到了这个 pipes 通用 lisp 库。它在某种程度上看起来很像 clojure 的惰性序列抽象，所以我决定用它来实现 Common Lisp 中递归惰性斐波那契序列定义的经典（和经典）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}>)

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

【问题讨论】：

无需避免很好地隐藏完全封装的内部语义上不可观察可变状态！你所需要的只是爱（我的意思是，SETF）。 :) （最后一个是个笑话；我们还可以开玩笑吗？）等效于 (setf (car...)) 和 (setf (cdr ...)) 通过将 lambda-under-let 放入列表的尾部 cons 单元格，以便该函数可以作为“self”访问该单元格，并且可以通过将该单元格设置为（cons value next-lambda）来扩展列表。
(contd.) 自然我必须有特殊的 stream-car 和 stream-cdr 来检查列表的 cons 单元格中对象的类型，如果这是一个函数，他们就会调用那个功能。所以我不能有函数列表。这当然可以很容易地补救（或解决），但我不需要它。
对于惰性序列的真正不同方法，请参见 SERIES 库。 cliki.net/SERIES
（我记错了；生成函数在最后一个 cons 单元格的cdr 中，因此将函数作为列表中的元素没有问题）
@WillNess 谢谢！我知道 SICP 风格，但我仍然觉得我错过了 common lisp 中的一些概念，我只是不知道。

标签： recursion clojure common-lisp metaprogramming let

【解决方案1】：

如果你有一个带有 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)。

【讨论】：

【解决方案2】：

经过一番冥想，我得到了这个解决方案：

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

【讨论】：