#:g1: Telos in Common Lispの紹介

(LISP Library 365参加エントリ)

　LISP Library 365 の285日目です。

Telos in Common Lispとはなにか

　Telos in Common Lispは、Russell Bradford氏作のEuLispのオブジェクト指向システムのTelosをCommon Lispに移植したものです。

パッケージ情報

インストール方法

　上記の配布サイトからダウンロードしてきて動かします。
もしくは、ASDF対応にしてみたものがありますので、良かったらどうぞ。
Quicklispのlocal-projects以下に配置すれば、

(ql:quickload :telos)

で読み込めます。

• g000001/telos · GitHub

試してみる

　Telosは名前から察せられるようにCLOSの影響を受けているので書法も大体CLOS風です。
違いといえば、EuLispがLisp-1の為、CLOSのように名前に対して操作をするというよりはScheme上のオブジェクト指向システムと同じく無名オブジェクトを操作する感じになります。
Telos in Common LispでもCLOSでクラス名が来るところは評価されるようになっています。

(defclass <foo> () ())
<foo>
;=>  #class(foo [simple-class])

こんな感じに変数の値としてクラスオブジェクトが入るので、名前の衝突を防ぐために<クラス名>という命名規約が有用になってきます(とはいえCommon Lispでも真似してる人もいますが)。

　ということで、毎度お馴染BankAccountを書いてみます。

• BankAccount

(defpackage :telos.demo
  (:use :telos :cl)
  (:shadowing-import-from :telos
   :slot-value :remove-method :make-method :find-method :describe :defmethod
   :defgeneric :defclass :class-of :class-name :call-next-method :call-method
   :add-method))

(cl:in-package :telos.demo)

(defclass <bank-account> ()
  ((dollars :default 0 :accessor dollars :keyword :dollars)))

(defgeneric deposit ((a <bank-account>) (n <number>)))

(defmethod deposit ((a <bank-account>) (n <number>))
  (incf (dollars a) n))

(defgeneric withdraw ((a <bank-account>) (n <number>)))

(defmethod withdraw ((a <bank-account>) (n <number>))
  (setf (dollars a)
        (max 0 (- (dollars a) n))))

(defparameter *my-account* (make <bank-account> :dollars 200))

(dollars *my-account*)
;=>  200
(deposit *my-account* 50)
;=>  250
(withdraw *my-account* 100)
;=>  150
(withdraw *my-account* 200)
;=>  0
(defclass <stock-account> (<bank-account>)
  ((num-shares :default 0 :accessor num-shares :keyword num-shares)
   (price-per-share :default 30 :accessor price-per-share :keyword price-per-share)))

(defgeneric dollars ((a <stock-account>)))

(defmethod dollars ((a <stock-account>))
  (* (num-shares a) (price-per-share a)))

(defgeneric (setf dollars) ((a <stock-account>) (n <number>))) ;CLOSと引数の順番が逆
(defmethod (setf dollars) ((a <stock-account>) (n <number>))
  (setf (num-shares a) (/ n (price-per-share a)))
  (dollars a))

(defparameter *my-stock* (make <stock-account> :num-shares 10))

(dollars *my-stock*)
;=>  300
(setf (dollars *my-stock*) 600)
;=>  600
(deposit *my-stock* 60)
;=>  660
(num-shares *my-stock*)
;=>  22
(withdraw *my-stock* 120)
;=>  540
(num-shares *my-stock*)
;=>  18

微妙に違いますが、大体同じなのが分かると思います。
defclassのオプション等はTelosの方が直感的で暗記しやすいかも

• An Implementation of Telos in Common Lisp(PS)

によるとMOPもサポートということなので、簡単そうなところでシングルトンクラスを書いてみます。

(defclass <singleton-class> (<simple-class>)
  ((instance :default '())))

(defun make-singleton (cl &rest keywords)
  (or (and (eq <singleton-class> (class-of cl))
           (slot-value cl 'instance))
      (let ((inst (initialize (allocate cl keywords) keywords)))
        (setf (slot-value cl 'instance) inst)
        inst)))

(defclass <kandi> ()
  ((s :default 0 :keyword :s))
  :class <singleton-class>)

(eq (make-singleton <kandi>)
    (make-singleton <kandi>))
;=>  T

ご覧のようにメタクラスにスロットが付いてるだけという、非常に残念なものになりました。
一応言い訳としては、

• makeが総称関数でない
• allocateでクラスからインスタンスを生成してinitializeで初期化。allocateでキャッシュするとしても、二回目以降にinitializeを迂回する良い方法がない。

ということで悩んでmake-singletonを作成するということに。
initializeがclass-slotsを呼ぶので、class-slotsを特定化しても迂回できそうですが、class-slotsも普通の関数。
他に考えられるとしたら、シングルトンクラスのスロットを専用のものにして再初期化を迂回する、等でしょうか。
Telosの作法ではどうするのが正しいのか知りたいところです。

まとめ

　今回は、Telos in Common Lispを紹介してみました。
<クラス名>はLisp-1では必然なのですが、Lisp-2では皆無かというとそうでもなく、ISLispの仕様ではそういう感じになっていたりします。
ISLispは、Lisp-1かLisp-2かで揺れていたようで、<クラス名>を受けつけるオペレーターは全部スペシャルフォームになっていて、クォートは付けなくて良いようになっていたりして、なにか辻褄合わせ的なものを感じます。