使用Common Lisp进行简单的OO风格编程

时间:2018-12-20 01:51:18

标签: common-lisp

我正在尝试制作“伪OO系统”:

(defun bank-account ()
  (let ((balance))
    (labels ((init (x)
               (setf balance x))
             (increment (x)
               (setf balance (+ balance x)))
             (get-balance ()
               balance))
      (lambda (func)
        (case func (init #'init)
                   (increment #'increment)
                   (get-balance #'get-balance))))))

(defparameter bank-account-object (bank-account))

(funcall (funcall bank-account-object 'init) 42)
(funcall (funcall bank-account-object 'increment) 10)
(funcall (funcall bank-account-object 'get-balance))

Q:是否有更好的方法可以在不使用CLOS,defstruct或defmacro的情况下完成相同的工作?

3 个答案:

答案 0 :(得分:3)

我看到的问题是它已关闭以进行扩展,而且我看不到添加扩展性的简单方法。

次要nitpick:这不是bank-system,而是bank-account。当您进一步考虑时,在我看来,关于此示例域的有趣部分并未被触及:双重记帐,即i。 e。确保零和不变。

有两种说法:闭包是穷人的对象,而对象是穷人的对象。我觉得您在这里更前者的境界。但是,考虑一下这可能是一个很好的学习经验,只要您不将其投入生产……

答案 1 :(得分:1)

;; The "class"
(defun create-bank-account ()
  (let ((balance))
    (labels ((init (x)
               (setf balance x))
             (increment (x)
               (setf balance (+ balance x)))
             (get-balance ()
               balance))
      (lambda (func)
        (case func (init #'init)
                   (increment #'increment)
                   (get-balance #'get-balance))))))


;; The "methods"
(defun init-balance (object amount)
  (funcall (funcall object 'init) amount))

(defun increment-balance (object amount)
  (funcall (funcall object 'increment) amount))

(defun get-balance (object)
  (funcall (funcall object 'get-balance)))

;; Example usage
(defparameter bank-account (create-bank-account))   
(init-balance bank-account 42) ; => 42
(increment-balance bank-account 10) ; => 52
(get-balance bank-account) ; => 52

答案 2 :(得分:1)

如其他答案中所述,生成的对象可能很难扩展。那可能是一个功能,但是改进它的一种可能方法是让它动态地重新定义。您甚至可以从类切换到原型。

(ql:quickload :optima)
(defpackage :obj (:use :cl :optima))
(in-package :obj)

(defun make-object (&optional prototype)
  (let ((properties (make-hash-table :test #'eq))
        (self))
    (flet ((resolve (key)
             (or (gethash key properties)
                 (and prototype (funcall prototype :get key)))))
      (setf self
            (lambda (&rest args)
              (optima:ematch args
                ((list :get :prototype) prototype)

                ((list :get key) (resolve key))

                ((list :set :prototype p)
                 (cerror "Continue" "Changing prototype object, are you sure?")
                 (setf prototype p))

                ((list :set key value)
                 (if value
                     (setf (gethash key properties) value)
                     (remhash key properties)))

                ((list :invoke method args)
                 (let ((resolved (resolve method)))
                   (if resolved
                       (apply resolved self args)
                       (funcall (or (resolve :no-such-method)
                                    (error "No such method: ~a in ~a"
                                           method
                                           self))
                                self
                                method))))))))))

一些辅助符号:

;; call built-in command
(defmacro $ (obj method &rest args)
  `(funcall ,obj ,method ,@args))

;; access property
(declaim (inline @ (setf @)))
(defun @ (o k) ($ o :get k))
(defun (setf @) (v o k) ($ o :set k v))

;; invoke method
(defun % (o m &rest a)
  ($ o :invoke m a))

一个简单的测试

(let ((a (make-object)))
  ;; set name property
  (setf (@ a :name) "a")
  ;; inherit
  (let ((b (make-object a)))
    (print (list (@ b :name)
                 ;; shadow name property
                 (setf (@ b :name) "b")
                 (@ a :name)))

    ;; define a method
    (setf (@ a :foo) (lambda (self) (print "FOO")))
    ;; invoke it
    (% a :foo)))

银行帐户

(defun create-bank-account (&optional parent)
  (let ((account (make-object parent)))
    (prog1 account
      (setf (@ account :init)
            (lambda (self x)
              (setf (@ self :balance) x)))
      (setf (@ account :increment)
            (lambda (self increment)
              (incf (@ self :balance) increment))))))

(let ((account (create-bank-account)))
  (% account :init 0)
  (% account :increment 100)
  (@ account :balance))

100