実践Common Lispを読んでみる11

実践Common Lisp

今日はオブジェクト指向入門を途中まで。いま205ページくらい。…まだ半分いかないなあ。
C++とかC#とかとは全然違う。Javascriptのオブジェクト指向も結構違う感じだったし、Perlのオブジェクト指向も結構違う感じだったし、Pythonも違う感じだったけれども、これは飛び抜けて異質。

以下、ソースコード。
今日のは長いぜ。

(defgeneric draw (shape)
  (:documentation "draw shape on screen"))
;; 日本語通すとエラーになるからコメントにする
;; (defgeneric withdraw (account amount)	;amountで指定された額を口座から引き落とす。足りなかったらエラー
;;   (:documentation ""))
;; (defmethod withdraw ((account bank-account) amount)
;;   (when (< (balance account) amount)
;;     (error "Account overdrawn."))
;;   (decf (balance account) amount))
;; (defmethod withdraw ((account checking-account) amount)
;;   (let ((overdraft (- amount (balance account))))
;;     (when (plusp overdraft)
;;       (withdraw (overdraft-account account) overdraft)
;;       (incf (balance account) overdraft)))
;;   (call-next-method))
;; (defmethod withdraw ((proxy proxy-account) amount)
;;   (withdraw (proxied-account proxy) amount))

;; (defmethod withdraw :before ((account checking-account) amount)
;;   (let ((overdraft (- amount (balance account))))
;;     (when (plusp overdraft)
;;       (withdraw (overdraft-account account) overdraft)
;;       (incf (balance account) overdraft))))

(defclass bank-account ()
  (customer-name
   balance))
;; (make-instance 'bank-account)
(defparameter *account* (make-instance 'bank-account))
(setf (slot-value *account* 'customer-name) "John Doe")
(setf (slot-value *account* 'balance) 1000)
;; (slot-value *account* 'customer-name)
;; (slot-value *account* 'balance)
(defclass bank-account ()
  ((customer-name
    :initarg :customer-name)
   (balance
    :initarg :balance
    :initform 0)))
(defparameter *account*
  (make-instance 'bank-account :customer-name "John Doe" :balance 1000))
(defvar *account-numbers* 0)
(defclass bank-account ()
  ((customer-name
    :initarg :customer-name
    :initform (error "Must supply a customer name."))
   (balance
    :initarg :balance
    :initform 0)
   (account-number
    :initform (incf *account-numbers*))
   account-type))
;; (slot-value *account* 'account-number)
(defmethod initialize-instance :after ((account bank-account) &key)
  (let ((balance (slot-value account 'balance)))
    (setf (slot-value account 'account-type)
	  (cond
	    ((>= balance 100000) :gold)
	    ((>= balance 50000) :silver)
	    (t :bronze)))))
;; (slot-value *account* 'account-type)
(defmethod initialize-instance :after ((account bank-account)
				       &key opening-bonus-percentage)
  (when opening-bonus-percentage
    (incf (slot-value account 'balance)
	  (* (slot-value account 'balance) (/ opening-bonus-percentage 100)))))
;; (defparameter *acct* (make-instance
;; 		      'bank-account
;; 		      :customer-name "Sally Sue"
;; 		      :balance 1000
;; 		      :opening-bonus-percentage 5))

;; (defun (setf customer-name) (name account)
;;   (setf (slot-value account 'customer-name) name))
;; (setf (customer-name my-account) "Sally Sue")

(defgeneric (setf customer-name) (value account))
(defmethod (setf customer-name) (value (account bank-account))
  (setf (slot-value account 'customer-name) value))
(defgeneric customer-name (account))
(defmethod customer-name ((account bank-account))
  (slot-value account 'customer-name))
;; (setf (customer-name *account*) "Sally Sue")
;; (customer-name *account*)

(defclass bank-account ()
  ((customer-name
    :initarg :customer-name
    :initform (error "Must supply a customer name.")
    :accessor customer-name
    :documentation "customer-name")
   (balance
    :initarg :balance
    :initform 0
    :reader balance
    :documentation "current balance")
   (account-number
    :initform (incf *account-numbers*)
    :reader account-number
    :documentation "account-number")
   (account-type
    :reader account-type
    :documentation "account-type. gold/silver/bronze")))

http://dl.getdropbox.com/u/228440/veleno-samples/lisp-samples/sample.lisp