3

From reading a Lisp book I remember they showed an example of an OOP-style method dispatcher based on closures:

(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

Since it's just a function with a string symbol argument, I guess code intel won't be of much help here, not completing the method names or their signatures. (Compare with a similar JavaScript object.)

Is this problem generally solved? How do you program an object system in Scheme so that an editor (like Emacs) can be more intelligent with your code?

P.S. The example may be not a valid Scheme code, but you should get the idea.

4

3 回答 3

3

I'm not a Emacs user, but use DrRacket and it does have an object system and do what an IDE should do, but I know Emacs is very customizable since it uses elisp so you can make support for your own syntax both in syntax highlighting and tab-completion. So you do:

  1. Make your own object system
  2. Edit your Emacs editor to do what you want

Many of my colleagues use it and they fix their Emacs in such ways.

Another thing, this question makes me think about the resources at schemewiki.org on the subject where the different approaches are mentioned and even a similar code to the one you posted is posted as example. It's a good read.

于 2013-11-19T12:14:01.627 回答
3

I've made some starting code for you. It's for Emacs Lisp, but it's should be very easily portable to Scheme.

Here's your usage example:

(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)

And here's how it's implemented:

(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))

And here's a simple visual interface for completions:

(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)))))))) 
于 2013-11-29T14:40:32.577 回答
2

I would avoid double notion of symbols in create-object via an obarray. Furthermore, the interface of the object are all functions. Therefore, use fset and avoid the double 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)

Example for inheritance:

(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)

The definition of create-object-like methods should additionally be supported through macros. That is not done here.

For more features, note, there is a CLOS-compatible object oriented system in emacs:

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

于 2013-11-30T09:02:16.523 回答