next up previous
Next: 12 オブジェクト指向 Up: 11 データ指向型プログラミング Previous: 11.4 Generic Function

11.5 クラスの定義例

new-accountのようにクロージャを返す関数を個別に作るのではなく, クラスのひとつとしてアカウントを定義するというようなマクロを 作れば,ひとつのマクロで,さまざまなクラスを作ることが可能 となる.

(defmacro define-class
   (class inst-vars class-vars &body methods)
  `(let ,class-vars
     (mapcar #'ensure-generic-fn
             ',(mapcar #'first methods))
     (defun ,class ,inst-vars
       #'(lambda (message)
           (case message
             ,@(mapcar #'make-clause methods))))))

(defun make-clause (clause)
  `(,(first clause)
      #'(lambda ,(second clause) .,(cddr clause))))


(defun ensure-generic-fn (message)
  (unless (generic-fn-p message)
    (let ((fn #'(lambda (object &rest args)
                  (apply (get-method object message)
                         args))))
      (setf (symbol-function message) fn)
      (setf (get message 'generic-fn) fn))))

(defun generic-fn-p (fn-name)
  (and (fboundp fn-name) 
       (eq (get fn-name 'generic-fn)
           (symbol-function fn-name))))
というような,define-classというマクロを定義すれば, new-accountの中で行っているように,メッセージごとに case文を作り,そのメッセージごとにGeneric Function を作る.たとえば,

(define-class account
       (name &optional (balance 0.00))
                       ((interest-rate .06))
  (withdraw (amt) (if (<= amt balance)
                      (decf balance amt)
                      'insufficient-funds))
  (deposit  (amt) (incf balance amt))
  (balance  ()   balance)
  (name     ()   name)
  (interest ()   (incf balance
                  (* interest-rate balance))))
という具合に口座を定義すれば,

> (setf acct2 (account "inaba" 200))
#<Interpreted Closure ...>
> (deposit acct2 30)
230
> (interest acct2)
243.8
> (balance acct2)
243.8
という具合に使うことができる. べつのクラスとして,パスワードが必要な口座クラス (password-account)を作るときには, すでにaccountクラスでGeneric Function が作られているので,そのaccountクラスに定義されている メッセージ用の定義は必要なくなる.

(define-class password-account (password acct) ()
  (change-password (pass new-pass)
                   (if (equal pass password)
                       (setf password new-pass)
                       'wrong-password))
  (otherwise (pass &rest args)
             (if (equal pass password)
                 (apply message acct args)
                 'wrong-password)))
というように定義すると,

> (setf acct3 (password-account "secret" acct2))
#<Interpreted Closure ...>
> (balance acct3 "secret")
243.8
> (deposit acct3 "secret" 10)
253.8
> (balance acct3 "secret")
253.8
> (balance acct3 "inaba")
WRONG-PASSWORD
> (withdraw acct3 "secret" 30)
223.8
> (balance acct3 "secret")
223.8
というようにパスワードを必要とする口座acct3に対しても, balance,depositなどの処理が可能となっている. さらに,引き出し額に制限がある口座limited-accountの クラスを以下のように定義すると,

(define-class limited-account (limit acct) ()
  (withdraw  (amt)
             (if (> amt limit)
                 'over-limit
                 (withdraw acct amt)))
  (otherwise (&rest args)
             (apply message acct args)))
という具合に,withdrawの定義が異なる定義がなされる. これを実行すると,

> (setf acct4 (password-account "pass"
                (limited-account 100.00
                  (account "tanaka" 500.00))))
#<Interpreted Closure ...>
> (withdraw acct4 "pass" 200)
OVER-LIMIT
> (withdraw acct4 "pass" 50)
450.0
> (withdraw acct4 "guess" 20)
WRONG-PASSWORD
という具合に,password-accountの機能,accountの機能も 利用できるようになる.

generated through LaTeX2HTML. M.Inaba 平成18年5月7日