#:g1: ScmObjの紹介

Posted 2014-11-05 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の310日目です。

ScmObjとはなにか

 ScmObjは、Dorai Sitaram氏作のCLOS風のSchemeのオブジェクト指向システムです。

パッケージ情報

パッケージ名ScmObj
プロジェクトサイト ScmObj: An Object System for Scheme

インストール方法

 プロジェクトサイトからダウンロードしてきてScheme処理系に読み込ませます。
動作にはslibが必要とあります。

試してみる

 slibが必要ということで、試してみた処理系はGaucheです(slibはGaucheでもオプションですが)。
とはいえslibに依存しているところはそんなに多くはないようなのでslib無しでの移植も難しくはない気がします。
使い方については、プロジェクトサイトに詳しいですが、多重継承、多重メソッド、:before、:after、:aroundのメソッド結合ありなCLOS風のオブジェクト指向システムです。但しMOPはありません。

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

(define <bank-account>
  (make-class () (:dollars)))

(define dollars (make-generic-procedure a))

(defmethod dollars ((a <bank-account>)) (slot-value a :dollars))

(define set-dollars (make-generic-procedure a val))

(defmethod set-dollars ((a <bank-account>) (val #t)) (set-slot-value a :dollars val))

(define deposit (make-generic-procedure a n))

(defmethod deposit ((a <bank-account>) (n #t)) (set-dollars a (+ n (dollars a))) (dollars a))

(define withdraw (make-generic-procedure a n))

(defmethod withdraw ((a <bank-account>) (n #t)) (set-dollars a (max 0 (- (dollars a) n))) (dollars a))

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

(dollars *my-account*) ;=> 200

(deposit *my-account* 50) ;=> 250

(withdraw *my-account* 100) ;=> 150

(withdraw *my-account* 200) ;=> 0

(define <stock-account> (make-class (<bank-account>) (:num-shares :price-per-share)))

(define num-shares (make-generic-procedure a))

(defmethod num-shares ((a <stock-account>)) (slot-value a :num-shares))

(define price-per-share (make-generic-procedure a))

(defmethod price-per-share ((a <stock-account>)) (slot-value a :price-per-share))

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

(defmethod set-dollars ((a <stock-account>) (n #t)) (set-slot-value a :num-shares (/ n (price-per-share a))) (dollars a))

(define *my-stock* (make-instance <stock-account> :dollars 0 :price-per-share 30 :num-shares 10))

(dollars *my-stock*) ;=> 300

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

 クラスのスロット定義はスロット名のみなのでアクセサは自前で定義。
メソッド定義時に総称関数が自動で作成されることもないので明示的に定義。
スロットのデフォルト値もないということで、インスタンス生成時に指定。
という感じです。

 メソッド結合があるということなので、<stock-account>のdepositを実際のスロットにアクセスするように書き直してみます。

(define <stock-account>
  (make-class (<bank-account>)
    (:num-shares :price-per-share)))

(define num-shares (make-generic-procedure a))

(defmethod num-shares ((a <stock-account>)) (slot-value a :num-shares))

(define price-per-share (make-generic-procedure a))

(defmethod price-per-share ((a <stock-account>)) (slot-value a :price-per-share))

(defmethod dollars :before ((a <stock-account>)) (set-slot-value a :dollars (* (num-shares a) (price-per-share a))))

(defmethod set-dollars ((a <stock-account>) (n #t)) (set-slot-value a :num-shares (/ n (price-per-share a))) (dollars a))

(define *my-stock* (make-instance <stock-account> :dollars 0 :price-per-share 30 :num-shares 10))

(dollars *my-stock*) ;=> 300

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

dollarsスロットをアクセスする前に計算を:beforeメソッドで済ませます。どっちかというと、元の書法よりこっちの方が素直な気も。

まとめ

 今回は、ScmObjを紹介してみました。
現在のChickenのメインのオブジェクト指向システムはcoopsですが、ScmObjをベースにしたものとのこと。
これ位の機能があれば大体間に合いそうです。

comments powered by Disqus