CommonLispでCLOSを使わずにオブジェクト指向する

#何の記事？
lispでオブジェクト指向するといって真っ先に思い浮かぶのはCLOSでしょう。
しかし、今回はCLOSを使わずに自前のオブジェクトシステムを作ってオブジェクト指向してみました。

#作ったもの
javascriptみたいなプロトタイプベースのオブジェクトシステム

#どんなかんじ？？
こんな感じになりました。

jsos.lisp

;; prototype key
(defvar +prototype+ '-prototype-)
;; initialize function key
(defvar +initialize+ 'initialize)

;; make new object
(defun new (&optional (prot nil))
  (let ((obj (make-hash-table :test #'equal)))
    (if prot
        (setf (gethash +prototype+ obj) prot)
        (setf (gethash +prototype+ obj) +object+))
    (initialize-obj obj)
    obj))

;; get property value
(defun getv (ht key) (gethash key ht))

;; get short
(defun -> (ht sym) (gethash key ht))

;; get prop short
(defmacro => (ht sym) `(gethash ',sym ,ht))

;; set property value
(defun setv (ht key val) (setf (gethash key ht) val))

;; set short
(defun -< (ht key val) (setf (gethash key ht) val))

;; set prop short
(defmacro =< (ht sym val) `(setf (gethash ',sym ,ht) ,val))

;; call function
(defmacro send (ht sym &rest vals) `(funcall (lookup ,ht ',sym) ,ht ,@vals))

;; call function
(defmacro ? (ht sym &rest vals) `(funcall (lookup ,ht ',sym) ,ht ,@vals))

;; call initialize
(defun initialize-obj (ht)
  (let ((fnls (reverse (lookup-chain ht +initialize+))))
    (mapcar
      (lambda (fn)
        (if fn (funcall fn ht) nil))
      fnls)))

;; lookup prototype chain
(defun lookup (ht sym)
  (if ht
    (if (nth-value 1 (gethash sym ht))
      (gethash sym ht)
      (lookup (gethash +prototype+ ht) sym))
    (error "no property or method found")))

;; lookup prototype chain
(defun lookup-chain (ht sym)
  (labels (
    (lookup-chain-1 (ht sym ls)
      (if (gethash +prototype+ ht)
         (lookup-chain-1 (gethash +prototype+ ht) sym (append ls (list (gethash sym ht))))
         (append ls (list (gethash sym ht))))))
    (lookup-chain-1 ht sym (list))))

;-------------------------------------------------
; preset
(defvar +object+ (make-hash-table :test #'equal))
(-< +object+ +initialize+ (lambda (this) (-< this 'this this)))
(=< +object+ to-string (lambda (this) "object"))
; --------------------------------------------------------

#何してんのコレ？
lispのハッシュマップを使って擬似オブジェクトをつくっています。
プロトタイプも同様にハッシュマップで表現していて継承(単純にプロトタイプチェーンを追うだけ)もできます。
setfみたいにsetter/getter両方つかえるような書き方がわからなかったので分けて書いています。
=>, =< を使えばプロパティにアクセスする際にプロパティ名にクォートをつけなくてもいいようにしてあります。

#どうやってオブジェクト指向するの？
こんなかんじで使います。

jsos-test.lisp

;; 動物プロトタイプを定義
(defvar prot-animal (new))
(=< prot-animal initialize
  (lambda (this)
    (=< this name "名無しのどうぶつ")
    (=< this age 0)
    (=< this mood "ふつう")))
(=< prot-animal cry
  (lambda (this)
    (format t "...~%")))
(=< prot-animal print-detail
  (lambda (this)
    (format t "名前 : ~S, 年齢 : ~S, 機嫌 : ~S~%" (=> this name) (=> this age) (=> this mood))))

;; 猫プロトタイプを定義
(defvar prot-cat (new prot-animal))
(=< prot-cat initialize
  (lambda (this)))
(=< prot-cat cry
  (lambda (this)
    (format t "にゃー~%")))
(=< prot-cat water
  (lambda (this)
    (format t "ないわー、猫に水かけるとかまじないわー~%")
    (=< this mood "おこ")))
(=< prot-cat calc 
  (lambda (this x y)
    (format t "~S!" (+ x y))))

(defparameter *cat* (new prot-cat))
(=< *cat* name "ねこ001")
(=< *cat* age 3)

(? *cat* cry) ; => にゃー
(? *cat* print-detail) ; => 名前 : "ねこ001", 年齢 : 3, 機嫌 : "ふつう"
(? *cat* water) ; => ないわー、猫に水かけるとかまじないわー
(? *cat* print-detail) ; => 名前 : "ねこ001", 年齢 : 3, 機嫌 : "おこ"
(? *cat* calc 1 2) ; => 3!

#書き方キモくない？
気にしてはいけません:)
(マクロの書き方がよくわかんない...)

#まとめ
簡単なオブジェクトシステムであれば意外と簡単にかけるんだなぁと。
マクロをうまくつかえばもっとシンプルにメソッドのコールとかプロパティのアクセスとか
書けるんじゃないかとおもいます。

やってみた的な記事になってしまったので反省＾＾；

#環境とか
OS : Windows 10
処理系 : SBCL 1.2.15

#追記1
折角なのでコードをgithubにあげてみました。
私が英語を書くと壮絶なbroken englishになるのでコメントとかはすごく短くなってます。
github : https://github.com/singy15/lclos