Simple OO style programming with Common Lisp

Question

I am trying to make a 'pseudo OO system':

(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: are there better ways to accomplish the same without using CLOS, defstruct, or defmacro?

Answer 1

As mentioned in other answers, the resulting object might be hard to extend. That could be a feature, but one possible way to improve on it is to let it be redefined dynamically. You can even switch from classes to protoypes.

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

Some helper symbols:

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

A simple test

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

Bank account

(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

Answer 2

;; 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

Answer 3

The problem that I see with this is that it is closed for extension, and I see no simple way to add extensibility.

Minor nitpick: that's not a bank-system but a bank-account. When you think about that further, it seems to me that the interesting part about this example domain has not been touched: double accounting, i. e. ensuring the null-sum invariant.

There are two sayings: a closure is a poor man's object, and an object is a poor man's closure. I have the feeling that you are more in the realm of the former here. However, it might be a good learning experience to think about this—as long as you don't put it into production somewhere…