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

Question

我正在将一些Scheme代码转换为Common Lisp.我不知道Scheme.我知道一点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)

=> a

(b 'name)

=> b

a-cell在其中存储了名称"a".b-cell在其中存储了名称"b".我可以查询a-cell的名称,然后返回"a".我可以查询b-cell的名称,然后返回"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-cell和b-cell:

(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代码相同？

Answer 1

Common Lisp没有define像Scheme那样的内部(顺便说一句,就是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))

Answer 2

Chris Jester-Young已经给出了一个很好的答案,但是你可以稍微调整一下你的功能.请注意,这两个函数都没有ME按名称调用; 你可以用以下代码替换它LAMBDA:

(defun make-cell ()
  (let (local-name)
    (flet ((add-name (name) (setf local-name name)))
      (lambda (message)
        (ecase message
          ;; ADD-NAME is only used here, so you could make it a lambda too.
          (add-name #'add-name) 
          (name local-name))))))

如果您以后需要能够ME通过名称引用,亚历山大提供了一个NAMED-LAMBDA应该工作的宏.

当然,这看起来像是用闭包来实现对象.由于Common Lisp是一种多范式语言,所以最好在这里使用CLOS:

(defclass cell ()
  ((local-name :initform "" :initarg :name :reader name :writer add-name)))

(let ((cell (make-instance 'cell)))
  (format t "~&Name: ~a~%Add name: ~a~%Name: ~a~%"
          (name cell)
          (add-name "foo" cell)
          (name cell)))
; Name: 
; Add name: foo
; Name: foo