以纯/函数式语言（Elm/Haskell）实现自引用/指针

Question

抽象问题：

我想在 Elm 中实现一个自引用/指针。

具体问题：

我正在用 Elm 编写一个玩具 LISP 解释器，灵感来自 mal。

我正在尝试实现类似letrec 的东西来支持递归和相互递归绑定（我在上面提到的“自引用”和“指针”）。

下面是一些示例代码：

(letrec
  ([count (lambda (items)
            (if (empty? items)
                0
                (+ 1 (count (cdr items)))
            )
          )
  ])
  (count (quote 1 2 3))
)
;=>3

注意 lambda 的主体如何引用绑定 count。换句话说，函数需要对自身的引用。

更深层次的背景：

定义 lambda 后，我们需要创建一个 function closure，它由三个组件组成：

1. 函数体（调用函数时要计算的表达式）。
2. 函数参数列表（调用时绑定的局部变量）。
3. 闭包（可以在函数体中引用的所有非局部变量的值）。

来自维基百科文章：

闭包通常在创建闭包时使用 [...] 函数的词法环境（即可用变量集）的表示来实现。引用环境在创建闭包时将非本地名称绑定到词法环境中的相应变量，另外将它们的生命周期延长到至少与闭包本身的生命周期一样长。当稍后进入闭包时，可能使用不同的词法环境，函数会使用其非局部变量来执行，这些变量引用闭包捕获的变量，而不是当前环境。

基于上面的 lisp 代码，在创建 lambda 时，我们创建了一个闭包，其 count 变量必须绑定到 lambda，从而创建一个无限/循环/自引用。这个问题因相互递归的定义而变得更加复杂，letrec 也必须支持。

Elm 作为一种纯函数式语言，不支持命令式修改状态。因此，我认为在 Elm 中表示自引用值是不可能的。您能否提供一些关于在 Elm 中实现 letrec 的替代方案的指导？

研究与尝试

榆树中的马尔

Jos von Bakel 已经在 Elm 中实现了 mal。请参阅他的笔记here 和环境实现here。他不遗余力地手动构建了一个带有自己内部 GC 机制的指针系统。虽然这行得通，但这似乎是一场巨大的斗争。我渴望一个纯函数式的实现。

Haskell 中的 Mal

Haskell 中的 mal 实现（参见代码 here）使用 Data.IORef 来模拟指针。这对我来说也像是 hack。

Y 组合器/固定点

似乎可以使用 Y-Combinator 来实现这些自引用。似乎有一个Y* Combinator 也适用于相互递归函数。在我看来，还必须存在一个 Z* 组合子（相当于 Y*，但支持 eager evaluation model of Elm），这似乎是合乎逻辑的。我是否应该转换我的所有 letrec 实例，以便每个绑定都包裹在 Z* 周围？

Y-Combinator 对我来说是新的，我的直觉根本不理解它，所以我不确定上述解决方案是否有效。

结论

非常感谢您的阅读！由于这个问题，我已经好几天无法入睡了。

谢谢！

-Advait

Answer 1

表达式可以看到绑定的绑定构造不需要任何奇异的自引用机制。

它的工作原理是为变量创建一个环境，然后将值分配给它们。初始化表达式在这些变量已经可见的环境中进行评估。因此，如果这些表达式恰好是 lambda 表达式，那么它们会捕获该环境，这就是函数可以相互引用的方式。 解释器通过使用新变量扩展环境，然后使用扩展环境来评估分配来做到这一点。类似地，编译器扩展编译时词法环境，然后在该环境下编译分配，因此运行代码会将值存储到正确的帧位置。如果您有工作的词法闭包，那么能够相互递归的函数的正确行为就会弹出。

请注意，如果分配是按从左到右的顺序执行的，并且其中一个 lambda 恰好在初始化期间被调度，然后恰好通过一个尚未分配的变量对其中一个 lambda 进行前向调用，那么会有问题；例如

(letrec
  ([alpha (lambda () (omega)]
   [beta (alpha)] ;; problem: alpha calls omega, not yet stored in variable.
   [omega (lambda ())])
  ...)

请注意，在R7RS Scheme Report、P16-17、letrec 实际上记录为像这样工作。绑定所有变量，然后为它们分配值。如果 init 表达式的求值引用了正在初始化的同一个变量，或者引用了后面尚未初始化的变量，R7RS 会说这是一个错误。该文档还指定了有关使用初始化表达式中捕获的延续的限制。

Answer 2

在 Haskell 中，由于惰性求值，这相当简单。因为 Elm 是严格的，要使用下面的技术，您需要显式地引入惰性，这或多或少等同于添加您在问题中提到的那种指针间接层。

无论如何，Haskell 的答案可能对某人有用，所以这里......

从根本上说，自引用 Haskell 值很容易通过引入递归绑定来构造，例如：

let mylist = [1,2] ++ mylist in mylist

同样的原则可以用于编写解释器来构造自引用值。

给定以下简单的 S 表达式语言，用于构造具有整数原子的潜在递归/自引用数据结构：

data Expr = Atom Int | Var String | Cons Expr Expr | LetRec [String] [Expr] Expr

我们可以编写一个解释器来将其评估为以下类型，它不使用IORefs 或临时指针或类似的任何奇怪的东西：

data Value = AtomV Int | ConsV Value Value deriving (Show)

这样的解释器是：

type Context = [(String,Value)]

interp :: Context -> Expr -> Value
interp _ (Atom x) = AtomV x
interp ctx (Var v) = fromJust (lookup v ctx)
interp ctx (Cons ca cd) = ConsV (interp ctx ca) (interp ctx cd)
interp ctx (LetRec vs es e)
  = let ctx' = zip vs (map (interp ctx') es) ++ ctx
    in  interp ctx' e

这实际上是阅读器 monad 中的计算，但我已经明确地编写了它，因为 Reader 版本需要明确地或通过 RecursiveDo 语法使用 MonadFix 实例，因此会模糊细节。

代码的关键位是LetRec 的情况。请注意，通过引入一组可能相互递归的绑定来构建新的上下文。由于评估是惰性的，因此可以使用表达式 interp ctx' es 使用新创建的 ctx' 来计算值本身，它们是其中的一部分，并系递归结。

我们可以使用我们的解释器来创建一个自引用值，如下所示：

car :: Value -> Value
car (ConsV ca _cd) = ca

cdr :: Value -> Value
cdr (ConsV _ca cd) = cd

main = do
  let v = interp [] $ LetRec ["ones"] [Cons (Atom 1) (Var "ones")] (Var "ones")

  print $ car $ v
  print $ car . cdr $ v
  print $ car . cdr . cdr $ v
  print $ car . cdr . cdr . cdr . cdr . cdr . cdr . cdr . cdr . cdr . cdr $ v

这是完整的代码，还显示了一个替代的 interp' 使用带有递归-do 表示法的 Reader monad：

{-# LANGUAGE RecursiveDo #-}
{-# OPTIONS_GHC -Wall #-}

module SelfRef where

import Control.Monad.Reader
import Data.Maybe

data Expr = Atom Int | Var String | Cons Expr Expr | LetRec [String] [Expr] Expr
data Value = AtomV Int | ConsV Value Value deriving (Show)

type Context = [(String,Value)]

interp :: Context -> Expr -> Value
interp _ (Atom x) = AtomV x
interp ctx (Var v) = fromJust (lookup v ctx)
interp ctx (Cons ca cd) = ConsV (interp ctx ca) (interp ctx cd)
interp ctx (LetRec vs es e)
  = let ctx' = zip vs (map (interp ctx') es) ++ ctx
    in  interp ctx' e

interp' :: Expr -> Reader Context Value
interp' (Atom x) = pure $ AtomV x
interp' (Var v) = asks (fromJust . lookup v)
interp' (Cons ca cd) = ConsV <$> interp' ca <*> interp' cd
interp' (LetRec vs es e)
  = mdo let go = local (zip vs vals ++)
        vals <- go $ traverse interp' es
        go $ interp' e

car :: Value -> Value
car (ConsV ca _cd) = ca

cdr :: Value -> Value
cdr (ConsV _ca cd) = cd

main = do
  let u = interp [] $ LetRec ["ones"] [Cons (Atom 1) (Var "ones")] (Var "ones")
  let v = runReader (interp' $ LetRec ["ones"] [Cons (Atom 1) (Var "ones")] (Var "ones")) []

  print $ car . cdr . cdr . cdr . cdr . cdr . cdr . cdr . cdr . cdr . cdr $ u
  print $ car . cdr . cdr . cdr . cdr . cdr . cdr . cdr . cdr . cdr . cdr $ v

Answer 3

U 组合子

我在这里聚会迟到了，但我很感兴趣并花了一些时间研究如何用 Lisp 家族语言，特别是 Racket，并认为其他人可能会感兴趣。

我怀疑那里有很多关于这方面的信息，但是现在很难搜索任何看起来像“*-combinator”的东西（即使现在我正在创办一组名为“部件集成”的公司和等等）。

正如您所说，您可以使用 Y 组合器来执行此操作，但我不想这样做，因为我发现 Y 是我一次可以理解几个小时的东西，然后我必须全部工作又出来了。但事实证明，您可以使用更简单的东西：U 组合器。这似乎比 Y 更难搜索，但这里有一段关于它的引述：

在编程语言理论中，U 组合子 U 是将其参数应用于其参数的数学函数；即 U(f) = f(f)，或者等效地，U = λ f 。 f(f)。

自应用程序允许在 λ 演算中模拟递归，这意味着 U 组合器可以实现通用计算。 （U 组合器实际上比更著名的定点 Y 组合器更原始。）

表达式 U(U)，读作 U of U，是最小的非终止程序，[...]。

（来自here的文字，不幸的是，除了这句话之外，这不是一个关于U组合子的网站。）

先决条件

以下所有代码示例都在 Racket 中。宏当然是特定于 Racket 的。要使宏工作，您需要syntax-parse via：

(require (for-syntax syntax/parse))

但是请注意，我对syntax-parse 的使用是极端天真的：我实际上只是一个解冻的 CL 穴居人，假装了解 Racket 的宏系统。

另外注意我并没有无情地将所有东西都变成λ：这段代码中有lets，使用了多个值包括let-values、(define (f ...) ...)等等。

两个版本的 U

第一个版本的 U 很明显：

(define (U f)
  (f f))

但这会遇到应用顺序语言的一些问题，默认情况下是 Racket。为了避免这种情况，我们可以假设(f f) 将成为一个函数，并将该表单包装在另一个函数中以延迟其评估直到需要它：这是您必须在应用程序中为 Y 做的标准技巧-订购语言也是如此。我只会在必要时使用 applicative-order U，所以我会给它一个不同的名字：

(define (U/ao f)
  (λ args (apply (f f) args)))

另请注意，我允许多个参数，而不是做纯λ演算的事情。

使用U构造递归函数

为此，我们做了一个与 Y 类似的技巧：编写一个函数，如果给定一个处理递归情况的函数作为参数，它将返回一个递归函数。显然我会使用斐波那契函数作为规范递归函数。

所以，考虑一下这个问题：

(define fibber
  (λ (f)
    (λ (n)
      (if (<= n 2)
          1
          (+ ((U f) (- n 1))
             ((U f) (- n 2)))))))

这是一个函数，如果给定另一个函数 U 计算较小的斐波那契数，它将返回一个函数，该函数将计算 n 的斐波那契数。

也就是说，U这个函数就是斐波那契函数！

我们可以测试一下：

> (define fibonacci (U fibber))
> (fibonacci 10)
55

那太好了。

将 U 包装在宏中

因此，要隐藏所有这些，首先要做的是删除递归中对U 的显式调用。我们可以将它们完全从内部函数中提升出来：

(define fibber/broken
  (λ (f)
    (let ([fib (U f)])
      (λ (n)
        (if (<= n 2)
            1
            (+ (fib (- n 1))
               (fib (- n 2))))))))

不要尝试计算 U ：它会无限递归，因为 (U fibber/broken) -> (fibber/broken fibber/broken) 而这涉及计算 (U fibber/broken)，我们注定要失败。

我们可以使用U/ao:

(define fibber
  (λ (f)
    (let ([fib (U/ao f)])
      (λ (n)
        (if (<= n 2)
            1
            (+ (fib (- n 1))
               (fib (- n 2))))))))

这一切都很好((U fibber) 10) 是55（并终止！）。

这就是编写宏所需的全部内容：

(define-syntax (with-recursive-binding stx)
  (syntax-parse stx
    [(_ (name:id value:expr) form ...+)
     #'(let ([name (U (λ (f)
                        (let ([name (U/ao f)])
                          value)))])
         form ...)]))

这很好用：

(with-recursive-binding (fib (λ (n)
                               (if (<= n 2)
                                   1
                                   (+ (fib (- n 1))
                                      (fib (- n 2))))))
  (fib 10))

关于绑定的警告

这里很明显的一点是，这个宏构造了 两个 绑定：外部绑定和同名的内部绑定。而且这些在eq?的意义上并不绑定到同一个函数：

(with-recursive-binding (ts (λ (it)
                              (eq? ts it)))
  (ts ts))

是#f。这仅在绑定可以改变的语言中很重要：换句话说，一种带有赋值的语言。外部绑定和内部绑定，除非它们已经被改变，否则它们是相同的函数作为函数：它们为它们的参数的所有值计算相同的值。事实上，很难看出eq? 在没有赋值的语言中会起到什么作用。

此警告也适用于下面。

用于多种功能的两个版本的 U

U, U*, 对许多函数的明显推广是 U*(f1, ..., fn) 是元组 (f1(f1, ..., fn), f2(f1, ... , fn), ...)。在 Racket 中表达这一点的一种好方法是使用多个值：

(define (U* . fs)
  (apply values (map (λ (f)
                       (apply f fs))
                     fs)))

我们也需要应用顺序：

(define (U*/ao . fs)
  (apply values (map (λ (f)
                       (λ args (apply (apply f fs) args)))
                     fs)))

请注意，U* 是 U 的真正概括：(U f) 和 (U* f) 是相同的。

使用U*构造互递归函数

我将使用一对微不足道的函数：

• 如果对象是 cons 并且其 car 和 cdr 是数字对象，则该对象是 数字树；
• 一个对象是一个数字对象，如果它是一个数字，或者它是一个数字树。

所以我们可以定义 'maker' 函数（使用 '-er' 约定：生成 x 的函数是 xer，或者，如果 x 里面有连字符，一个 x-er) 会产生合适的功能：

(define numeric-tree-er
  (λ (nter noer)
    (λ (o)
      (let-values ([(nt? no?) (U* nter noer)])
        (and (cons? o)
             (no? (car o))
             (no? (cdr o)))))))

(define numeric-object-er
  (λ (nter noer)
    (λ (o)
      (let-values ([(nt? no?) (U* nter noer)])
        (cond
          [(number? o) #t]
          [(cons? o) (nt? o)]
          [else #f])))))

请注意，对于这两种情况，我稍微提高了对 U* 的调用，只是为了使对 U* 的适当值的调用不那么不透明。

这很有效：

(define-values (numeric-tree? numeric-object?)
  (U* numeric-tree-er numeric-object-er))

现在：

> (numeric-tree? 1)
#f
> (numeric-object? 1)
#t
> (numeric-tree? '(1 . 2))
#t
> (numeric-tree? '(1 2 . (3 4)))
#f

将 U* 包装在宏中

当我们对U* 进行内部调用时，会出现与之前相同的问题，结果相同：我们需要使用U*/ao。此外，宏变得更加毛茸茸，我对自己如此轻松地做对感到有点惊讶。这在概念上并不难：对我来说，模式匹配的工作并不明显。

(define-syntax (with-recursive-bindings stx)
  (syntax-parse stx
    [(_ ((name:id value:expr) ...) form ...+)
     #:fail-when (check-duplicate-identifier (syntax->list #'(name ...)))
     "duplicate variable name"
     (with-syntax ([(argname ...) (generate-temporaries #'(name ...))])
       #'(let-values
             ([(name ...) (U* (λ (argname ...)
                                (let-values ([(name ...)
                                              (U*/ao argname ...)])
                                  value)) ...)])
           form ...))]))

现在，在一阵火花中，我们可以写：

(with-recursive-bindings ((numeric-tree?
                           (λ (o)
                             (and (cons? o)
                                  (numeric-object? (car o))
                                  (numeric-object? (cdr o)))))
                          (numeric-object?
                           (λ (o)
                             (cond [(number? o) #t]
                                   [(cons? o) (numeric-tree? o)]
                                   [else #f]))))
  (numeric-tree? '(1 2 3 (4 (5 . 6) . 7) . 8)))

并获得#t。

---

正如我所说，我确信有众所周知的更好的方法可以做到这一点，但我认为这很有趣，不会输。