如何将返回闭包的Scheme函数转换为等效的Common Lisp函数？

Roger Costello 发表于 Dev

罗杰·科斯特洛

我正在将一些Scheme代码转换为Common Lisp。我不知道计划。我知道一些Common Lisp。

我认为我了解以下Scheme代码：

(define (make-cell)
    (let ((local-name '()))
       (define (local-add-name name)
           (set! local-name name))
        (define (me message)
            (cond ((eq? message 'add-name) local-add-name)
                  ((eq? message 'name) local-name)))
     me))

使用该函数，我可以创建两个单元格：

(define a (make-cell))
(define b (make-cell))

然后，我可以在每个单元格中存储一个名称：

((a 'add-name) 'a)
((b 'add-name) 'b)

然后，我可以检索存储在每个单元格中的名称：

(a 'name)

=>一个

(b 'name)

=> b

a单元在其中存储了名称“ a”。b单元内部已存储了名称“ b”。我可以查询a单元的名称，并返回“ a”。我可以查询b单元的名称，并返回“ b”。

到目前为止，我是否正确理解？

现在，我想使用Common Lisp实现相同的功能。这是我创建的make-cell函数：

(defun make-cell ()
    (let ((local-name nil))
        (defun local-add-name (name)
            (setf local-name name))
        (defun me (message)
            (cond ((eq message 'add-name) #'local-add-name)
                  ((eq message 'name) local-name)))))

显然这是错误的，因为它没有给出期望的行为，如我接下来显示的那样。

我制作了一个a单元和一个b单元：

(setf a (make-cell))
(setf b (make-cell))

我在每个单元格中存储一个名称：

(funcall (funcall a 'add-name) 'a)
(funcall (funcall b 'add-name) 'b)

当我检索名称时，两个单元格都返回相同的名称：

(funcall a 'name)

=> b

(funcall b 'name)

=> b

哎哟!

为什么两个单元格返回相同的名称？我究竟做错了什么？如何使CL代码的行为与Scheme代码相同？

克里斯·杰斯特·杨（Chris Jester-Young）

Common Lisp中没有内部define像计划做（这是，顺便说一句，语法糖letrec或letrec*^†）。在Common Lisp的等效的letrec是labels，这样你就可以使用这个：

(defun make-cell ()
  (let (local-name)
    (labels ((local-add-name (name)
               (setf local-name name))
             (me (message)
               (ecase message
                 (add-name #'local-add-name)
                 (name local-name))))
      #'me)))

这可以按您预期的方式工作（在SBCL上进行了测试）：

* (defvar *foo* (make-cell))

*FOO*
* (defvar *bar* (make-cell))

*BAR*
* (funcall (funcall *foo* 'add-name) "foo")

"foo"
* (funcall (funcall *bar* 'add-name) "bar")

"bar"
* (funcall *foo* 'name)

"foo"
* (funcall *bar* 'name)

"bar"

†这letrec是您的代码的版本：

(define (make-cell)
  (let ((local-name #f))
    (letrec ((local-add-name (lambda (name)
                               (set! local-name name)))
             (me (lambda (message)
                   (case message
                     ((add-name) local-add-name)
                     ((name) local-name)))))
      me)))

甚至：

(define (make-cell)
  (letrec ((local-name #f)
           (local-add-name (lambda (name)
                             (set! local-name name)))
           (me (lambda (message)
                 (case message
                   ((add-name) local-add-name)
                   ((name) local-name)))))
    me))

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。