用 pure/functional 语言实现 self-reference/pointer (Elm/Haskell)

Implement a self-reference/pointer in a pure/functional language (Elm/Haskell)

抽象问题:

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

具体问题:

我正在用受 mal 启发的 Elm 写一个玩具 LISP 解释器。

我正在尝试实现类似 letrec 的东西来支持递归和相互递归绑定(我在上面提到的 "self reference" 和 "pointers")。

下面是一些示例代码:

(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. 闭包(函数体内可能引用的所有非局部变量的值)。

来自维基百科文章:

Closures are typically implemented with [...] a representation of the function's lexical environment (i.e., the set of available variables) at the time when the closure was created. The referencing environment binds the non-local names to the corresponding variables in the lexical environment at the time the closure is created, additionally extending their lifetime to at least as long as the lifetime of the closure itself. When the closure is entered at a later time, possibly with a different lexical environment, the function is executed with its non-local variables referring to the ones captured by the closure, not the current environment.

基于上面的 lisp 代码,在创建 lambda 时,我们创建了一个闭包,其 count 变量必须绑定到 lambda,从而创建了一个 infinite/circular/self-reference。这个问题因相互递归定义而变得更加复杂,而相互递归定义也必须由 letrec 支持。

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

研究与尝试

榆树中的马尔

Jos von Bakel 已经在 Elm 中实现了 mal。见他的笔记 here and the environment implementation here。他不遗余力地手动构建了一个具有自己内部 GC 机制的指针系统。虽然这行得通,但这似乎需要大量的努力。我渴望一个纯函数式的实现。

Mal 在 Haskell

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

Y-Combinator/Fixed 积分

似乎可以使用 Y-Combinator 来实现这些自引用。好像有一个Y* Combinator that works for mutually recursive functions as well. It seems logical to me that there must also exist a Z* combinator (equivalent to Y* but supports the eager evaluation model of Elm)。我是否应该转换我的所有 letrec 个实例,以便每个绑定都围绕一个 Z*?

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

结论

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

谢谢!

-Advait

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

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

注意如果赋值顺序是从左到右,其中一个lambdas恰好在初始化时被分派,然后恰好通过一个尚未赋值的变量向前调用其中一个lambdas ,那将是一个问题;例如

(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 会说这是一个错误。该文档还指定了有关使用初始化表达式中捕获的延续的限制。

在 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

这实际上是 reader monad 中的一个计算,但我明确地写了它,因为 Reader 版本需要显式或通过 RecursiveDo 语法等会掩盖细节。

代码的关键位是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

这里是完整的代码,还显示了使用 Reader monad 和 recursive-do 表示法的替代 interp'

{-# 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

U 组合子

我来晚了,但我很感兴趣并花了一些时间研究如何用 Lisp 家族语言来做到这一点,特别是 Racket,我想也许其他人可能会感兴趣。

我怀疑那里有很多关于此的信息,但现在很难搜索任何看起来像“*-combinator”的东西(即使现在我正在创办一组名为 'Integration by parts' 等等)。

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

In the theory of programming languages, the U combinator, U, is the mathematical function that applies its argument to its argument; that is U(f) = f(f), or equivalently, U = λ f . f(f).

Self-application permits the simulation of recursion in the λ-calculus, which means that the U combinator enables universal computation. (The U combinator is actually more primitive than the more well-known fixed-point Y combinator.)

The expression U(U), read U of U, is the smallest non-terminating program, [...].

(来自 here 的文本,不幸的是,除此引述外,它不是关于 U 组合子的所有站点。)

先决条件

以下所有代码示例均在 Racket 中。宏肯定是 Racket 特定的。要使宏正常工作,您需要 syntax-parse 通过:

(require (for-syntax syntax/parse))

但是请注意,我对 syntax-parse 的使用极其天真:我真的只是一个假装理解 Racket 的宏系统的未冻结的 CL 穴居人。

另请注意,我并没有无情地将一切都变成λ:这段代码中有let,使用了多个值,包括let-values(define (f ...) ...)等。

U 的两个版本

U 的第一个版本是显而易见的:

(define (U f)
  (f f))

但这会 运行 应用顺序语言的一些问题,默认情况下 Racket 是这种语言。为避免这种情况,我们可以假设 (f f) 将成为一个函数,并将该形式包装在另一个函数中以延迟其评估,直到需要它为止:这是您必须为 Y 执行的标准技巧应用程序语言也是如此。我只会在必要时使用应用顺序 U,所以我会给它一个不同的名称:

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

另请注意,我允许多个参数而不是进行纯 λ 演算。

用U构造递归函数

为了做到这一点,我们做了一个类似于你对 Y 做的技巧:写一个函数,如果给定一个函数作为处理递归情况的参数,return 将是一个递归函数。显然,我将使用 Fibonacci 函数作为规范递归函数。

所以,考虑一下这件事:

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

这是一个函数,给定另一个函数,U 计算较小的斐波那契数,return 一个函数将计算 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.


正如我所说,我确信有更好的方法可以做到这一点,但我认为这很有趣,不会失败。