Question

通过阅读Lisp书，我记得他们展示了一个基于闭包的OOP风格方法调度程序的例子：

(defun create-object ()
  (let ((val 0)
        (get (lambda () val))
        (set (lambda (new-val) (setq val new-val)))
        (inc (lambda () (setq val (+ 1 val)))))
    (lambda (method)
      (cond ((eq method 'get)
             get)
            ((eq method 'set)
             set)
            ((eq method 'inc)
             inc)))))

(let ((obj (create-object)))
  (funcall (obj 'set) 1)
  (funcall (obj 'inc))
  (funcall (obj 'get))) ;; 2

由于它只是一个带有~~字符串~~符号参数的函数，我猜代码intel在这里没有太多帮助，没有完成方法名称或它们的签名。（与类似的JavaScript对象比较。）

这个问题一般都解决了吗？如何在Scheme中编写对象系统，以便编辑器（如Emacs）可以更智能地使用您的代码？

P.S。该示例可能不是有效的Scheme代码，但您应该明白这一点。

Answer 1

我不是Emacs用户，但是使用DrRacket并且它确实有一个对象系统并且做了IDE应该做的事情，但我知道Emacs可以自定义，因为它使用elisp所以你可以支持语法高亮和制表完成中您自己的语法。所以你这样做：

制作自己的对象系统
编辑您的Emacs编辑器以执行您想要的操作

我的很多同事都使用它，并以这种方式修复他们的Emacs。

另一件事，这个问题让我想到提到不同方法的resources at schemewiki.org on the subject，甚至与你发布的方法类似的代码也作为例子发布。这是一个很好的阅读。

Answer 2

我为你做了一些启动代码。它适用于Emacs Lisp，但它应该非常容易移植到Scheme。

以下是您的使用示例：

(defun create-object ()
  (lexical-let* ((val 0)
                 (get (lambda() val))
                 (set (lambda(x) (setq val x))))
    (generate-dispatch-table get set)))

(setq obj (create-object))
(funcall (funcall obj 'get))
;; => 0
(funcall (funcall obj 'set) 1)
;; => 1
(funcall (funcall obj 'get))
;; => 1
(scheme-completions obj)
;; => (get set)

以下是它的实施方式：

(defmacro generate-dispatch-table (&rest members)
  `(lambda (method)
     (cond ,@(mapcar
               (lambda (x) `((eq method ',x) ,x)) members))))

(defun collect (pred x)
  (when (and x (listp x))
    (let ((y (funcall pred x))
          (z (append
              (collect pred (car x))
              (collect pred (cdr x)))))
      (if y
          (append (list y) z)
        z)))) 

(defun scheme-completions (obj)
  (collect
   (lambda(x) (and (eq (car x) 'eq)
              (eq (cadr x) 'method)
              (eq (caaddr x) 'quote)
              (cadr (caddr x))))
   obj))

这是一个简单的完成视觉界面：

(require 'helm)
(defun scheme-completions-helm ()
  (interactive)
  (let ((y (and
               (looking-back "(funcall \\([^ ]*\\) +")
               (intern-soft (match-string 1)))))
    (when y
      (helm :sources
            `((name . "members")
              (candidates . ,(scheme-completions (eval y)))
              (action . (lambda(x) (insert "'" x))))))))

Answer 3

我会通过create-object避免obarray中符号的双重概念。此外，对象的界面都是功能。因此，请使用fset并避免使用双funcall。

(defun create-object ()
  (lexical-let (val
        (_oa (make-vector 11 0)))
    (fset (intern "get" _oa) (lambda () val))
    (fset (intern "inc" _oa) (lambda () (incf val)))
    (fset (intern "set" _oa) (lambda (new-val) (setq val new-val)))
    (lambda (method &rest args)
      (apply 'funcall (intern (symbol-name method) _oa) args))))


(fset 'obj1 (create-object))
(fset 'obj2 (create-object))

(obj1 'set 1)
(obj2 'set 2)

(obj1 'inc)
(obj2 'inc)
(obj2 'inc)

(obj2 'get)
(obj1 'get)

继承示例：

(defun create-object ()
  (lexical-let (val
        (_oa (make-vector 11 0)))
    (fset (intern "get" _oa) (lambda () val))
    (fset (intern "inc" _oa) (lambda () (incf val)))
    (fset (intern "set" _oa) (lambda (new-val) (setq val new-val)))
    (lambda (method &rest args)
      (apply 'funcall (or (intern-soft (symbol-name method) _oa)
              (error "Undefined function: %s" method))
         args))))


(defun create-object-add10 ()
  (lexical-let ((base (create-object))
        (_oa (make-vector 11 0)))
    (fset (intern "inc" _oa) (lambda () (funcall base 'set (+ (funcall base 'get) 10))))
    (lambda (method &rest args)
      (let ((call (intern-soft (symbol-name method) _oa)))
    (if call
        (apply 'funcall call args)
      (apply 'funcall base method args))))))

(fset 'obj1 (create-object))
(fset 'obj2 (create-object-add10))

(obj1 'set 1)
(obj2 'set 2)

(obj1 'inc)
(obj2 'inc)
(obj2 'inc)

(obj2 'get)
(obj1 'get)

还应通过宏来支持create-object类似方法的定义。这不是在这里完成的。

有关更多功能，请注意，emacs中有一个与CLOS兼容的面向对象系统：

https://www.gnu.org/software/emacs/manual/html_node/eieio/index.html

如何在Scheme中完成智能代码的完成？

3 个答案: