Mosh で Tiny CLOS 入門

mosh

Tiny CLOS というオブジェクトシステムを勉強する。
用意するものは Mosh (trunk rev 1070以降)。

参考

ささださんの Tiny CLOS 入門 - Tiny CLOS Tutorial。

import するライブラリ

  • (clos user)
  • (clos core)

クラスを作る

(define-class <person> () name age)

name, age というスロットを持つクラス。インスタンス変数ではなくてスロットというらしい。
() の部分は super class 。省略すると 。

インスタンスを作る

(define person1 (make <person>))

インスタンスを print する

(print-object person1 (current-output-port))
#<person {#<record instance-record >}>

面倒なので

(define (ppo obj)
  (print-object obj (current-output-port)))

を定義しておく。

インスタンス変数を参照する

slot-ref を利用する。

(display (slot-ref person1 'name))
()

現時点では何も設定していないので () 。

インスタンス変数のアクセサ

slot-ref を利用すると、ユーザーが の slot 構造に依存したコードを書いてしまうかもしれない。
アクセサを用意する。

;; generic function を作る
(define-generic get-name)

;; genric function get-name に <person> の get-name を追加
(define-method get-name ((p <person>))
  (slot-ref p 'name))

(display (get-name person1))

slot の変更

slot-set! で値を変更。

(slot-set! person1 'name 'higepon)
(test* (get-name person1) 'higepon)

インスタンス作成時に slot の初期化

いわゆるコンストラクタ的な動作。

;; initialize function に <person> クラスの処理を追加
(define-method initialize ((p <person>) init-args)
  (initialize-direct-slots p <person> init-args))

(define person2 (make <person> 'age 18 'name 'John))
(test* (get-name person2) 'John)

簡単な継承

簡単な継承。動作を色々観察する。

;; <person> を super class に
(define-class <painter> (<person>) pen)

;; インスタンス
(define painter1 (make <painter> 'name 'Paul 'age 18 'pen 'pencil))

;; name, age スロットはうまく初期化されている
(test* (slot-ref painter1 'name) 'Paul)
(test* (slot-ref painter1 'age) 18)

;; pen は initialize を書いていないので初期化されない
(test* (slot-ref painter1 'pen) '())


の初期化を書いてみる。

(define-method initialize ((p <painter>) init-args)
  (initialize-direct-slots p <painter> init-args))

(define painter2 (make <painter> 'name 'Paul 'age 28 'pen 'pencil))

(slot-ref painter2 'name) => '()
(slot-ref painter2 'age) => '()
(slot-ref painter2 'pen) => 'pencil

今度は name, age が初期化されなくなった。
initialize-direct-slots は direct-slots （ なら pen ）のみを initialize するものみたい。
親の initialize も呼びたいが今は呼ばれていない。
define-method で 'after を指定すると の initialize => の initialize のように呼ばれる事が分かった。

(define-method initialize 'after ((p <painter>) init-args)
  (initialize-direct-slots p <painter> init-args))

この after は method qualifier と呼ばれていて

  • after
  • before
  • around
  • primary

などがある。 before は after の逆。 around, primary は調べていない。

のアクセサを で使う

(test* (get-name painter2) 'Paul)

うまく名前がとれている。

print

print-object-with-slots を発見。こちらの方が良い。

(print-object-with-slots painter2 (current-output-port))

インスタンスやクラスの情報を得る

  • class-of : インスタンスのクラスを取得
  • class-direct-supers : super クラスのリスト
  • class-slots : class の slot
  • class-direct-slots : class の slot （super クラスのもの含まず）
(test* (class-of painter2) <painter>)
(test* (class-direct-supers <painter>) (list <person>))
(test* (class-direct-supers <person>) (list <object>))
(test* (class-slots <painter>) '((pen) (name) (age)))
(test* (class-direct-slots <painter>) '((pen)))

親のメソッドを呼んでみる

に hello メソッドを追加。

(define-generic hello)
(define-method hello ((p <person>))
  (format "Hello I'm ~a." (get-name p)))

;; <person> のインスタンスに対して呼び出す
(test* (hello person1) "Hello I'm higepon.")

;; <painter> のインスタンスに対して呼び出す
(test* (hello painter2) "Hello I'm Paul.")

意図通りの動作。
では に hello を追加してみる。

(define-method hello ((p <painter>))
  (format "Don't touch me <~a>." (get-name p)))

(test* (hello person1) "Hello I'm higepon.")
(test* (hello painter2) "Don't touch me <Paul>.")

の hello が呼ばれた。良い良い。

Template Method Pattern

DBI で使いそうなので試す。

(define-generic work)
(define-generic collect)
(define-generic show)

;; <person> で work を定義
(define-method work ((p <person>) something)
  (show p (collect p something)))

;; collect と show は <painter> で
(define-method collect ((p <painter>) thing)
  (list 'collected thing))

(define-method show ((p <painter>) lst)
  (format "<~a>" lst))

(test* (work painter2 'moge) "<(collected moge)>")

apply

(test* (apply work painter2 '(moge)) "<(collected moge)>")

ふむ。感じはつかめた。次は実践的なコードかな。