■

オブ脳オンライン http://www.geocities.jp/objectbrain/ メーリングリストに「Delphi版社長起立！」が紹介されたのに刺激されて、CLOS http://clisp.cons.org/ で社長起立を書いてみることに。
Lispは知ってるけどCLOSについては何も知らなかったので、調べていたらこんな素敵なページ http://www.geocities.co.jp/SiliconValley-Oakland/1680/clisp/ が。ここで勉強しながらstep0〜5まで書いてみた。step5はこんな感じになる。

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Shain
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass shain ()
  ((kihonkyu :accessor kihonkyu :initform 0))
)

(defmethod bonus ((s shain))
  (* (kihonkyu s) 3)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Tanto
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass tanto (shain)
  ()
)

(defmethod standup ((s tanto))
  (format T "Tanto stood up normally.~%")
)

(defmethod kyuryo ((s tanto))
  (kihonkyu s)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Shuninn
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass shuninn (shain)
  ()
)

(defmethod standup ((s shuninn))
  (format T "Shuninn stood up quickly.~%")
)

(defmethod kyuryo ((s shuninn))
  (+ (* (kihonkyu s) 2) 1)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Bucho
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass bucho (shain)
  ()
)

(defmethod standup ((s bucho))
  (format T "Bucho stood up reluctantly.~%")
)

(defmethod kyuryo ((s bucho))
  (* (kihonkyu s) 3)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; shain-factory
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass shain-factory () () )

(defmethod create-shain ((factory shain-factory) type)
  (cond
    )((eq type 'TANTO) (make-instance 'tanto))
    ((eq type 'SHUNINN) (make-instance 'shuninn))
    ((eq type 'BUCHO) (make-instance 'bucho))
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Shacho
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass shacho () () )

(defmethod main ((s shacho) type kihonkyu)
  (setq factory (make-instance 'shain-factory))
  (setq shain (create-shain factory type))(
  (setf (kihonkyu shain) kihonkyu)
  (standup shain)
  (format T "My kyuryo is ~D yen.~%" (kyuryo shain))(
  (format T "My bonus is ~D yen.~%" (bonus shain))(
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; test
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq shacho1 (make-instance 'shacho))(
(main shacho1 'tanto 100)
(main shacho1 'shuninn 100)
(main shacho1 'bucho 100)