Common Lisp對象系統(CLOS)的一個小小的實例

      本文是對《Practical Common Lisp》第16章的簡單代碼註解。CLOS爲Common Lisp Object System的縮寫，與全部面嚮對象語言相同，CLOS是基於類組織起來的，所不一樣的是廣義函數而非消息傳遞是對象與方法通訊的橋樑。

      如下是實現的幾個簡單功能，模擬電梯升降的邏輯可能有不妥之處，但不影響對簡單CLOS的表述。

;;;;;; 電梯模擬程序 ;;;;;
(defclass lift ()
  ((lift-length :initarg :lift-length
                :initform 3)
   (lift-wide :initarg :lift-wide
              :initform 2)
   (lift-height :initarg :lift-height
                :initform 3)
   (lift-status :initarg :lift-status
           :initform 1)
   (floor-count :initform 8
                :reader floor-count
                :writer (setf floor-count))
   (floor-number-now :initform 1
                     :reader floor-number-now
                     :writer (setf floor-number-now))))

#|
@brief 電梯運行延時

@param seconds -- 延時秒數
@use 常規函數調用
|#
(defun lift-delay (seconds)
  (sleep seconds))

#|
@brief  電梯開門

@param  my-lift -- my-lift爲lift類的實例，可經過 (defparameter my-lift (make-instance 'lift) 獲得。
@use    (lift-open my-lift)
|#
(defgeneric lift-open (my-lift)
  (:documentation "tell you door status about if it's opening."))
(defmethod lift-open ((my-lift lift))
  (format t "~a~%" "door of lift is opening.")
  (lift-delay 2)
  (format t "~a~%" "door of lift is opened."))

#|
@brief  電梯關門

@param  my-lift -- my-lift爲lift類的實例，可經過 (defparameter my-lift (make-instance 'lift) 獲得。
@use    (lift-close my-lift)
|#
(defgeneric lift-close (my-lift)
  (:documentation "tell you door status about if it's closing."))
(defmethod lift-close ((my-lift lift))
  (format t "~a~%" "door of lift is closing.")
  (lift-delay 2)
  (format t "~a~%" "door of lift is closed."))

#|
@brief  樓層層數

@param  my-lift -- my-lift爲lift類的實例，可經過 (defparameter my-lift (make-instance 'lift) 獲得。
@use    (floor-count my-lift)
|#
(defmethod floor-count ((my-lift lift))
  (slot-value my-lift 'floor-count))

#|
@brief  讀取當前所在樓層

@param  number -- 當前樓層號
@param  my-lift -- my-lift爲lift類的實例，可經過 (defparameter my-lift (make-instance 'lift) 獲得。
@use    (floor-number-now my-lift)
|#
;(defgeneric floor-number-now (my-lift)
;  (:documentation "tell floor number you are on now."))
(defmethod floor-number-now ((my-lift lift))
  (slot-value my-lift 'floor-number-now))

#|
@brief  設置當前所在樓層

@param  number -- 當前樓層號
@param  my-lift -- my-lift爲lift類的實例，可經過 (defparameter my-lift (make-instance 'lift) 獲得。
@use    (setf (floor-number-now my-lift) number)
|#
(defgeneric (setf floor-number-now) (number my-lift)
  (:documentation "set floor-number-now slot a value."))
(defmethod (setf floor-number-now) (number (my-lift lift))
  (setf (slot-value my-lift 'floor-number-now) number))

#|
@brief  乘坐上升中的電梯到達某層

@param  floor-number -- 要去的樓層號
@param  my-lift -- my-lift爲lift類的實例，可經過 (defparameter my-lift (make-instance 'lift) 獲得。
@use    (lift-up 3 my-lift)
|#
(defgeneric lift-up (floor-number my-lift))
(defmethod lift-up (floor-number (my-lift lift))
  (if (> floor-number (floor-count my-lift))
       (format t "~a~%" "沒有此樓層.")
       (if (> (floor-number-now my-lift) floor-number)
           ;(format t "~a~%" "請使用下樓功能:lift-down.")
           (progn
             (lift-up (floor-count my-lift) my-lift)
             (lift-down floor-number my-lift))
           (progn
             (loop for i from (floor-number-now my-lift) upto floor-number do 
                  (progn
                    (lift-delay 2)
                    (format t "~a~d~%" "now you are on floor" i)))
             (setf (floor-number-now my-lift) floor-number)))))

#|
@brief  乘坐降低中的電梯到達某層

@param  floor-number -- 要去的樓層號
@param  my-lift -- my-lift爲lift類的實例，可經過 (defparameter my-lift (make-instance 'lift) 獲得。
@use    (lift-down 4 my-lift)
|#
(defgeneric lift-down (floor-number my-lift))
(defmethod lift-down (floor-number (my-lift lift))
  (if (< floor-number 1)
      (format t"~a~%" "沒有此樓層.")
      (if (< (floor-number-now my-lift) floor-number)
          ;(format t "~A~%" "請使用上樓功能:lift-up.")
          (progn
            (lift-down 1 my-lift)
            (lift-up floor-number my-lift))
          (progn
            (loop for i from (floor-number-now my-lift) downto floor-number do
                 (progn
                   (lift-delay 2)
                   (format t "~a~d~%" "now you are on floor" i)))
            (setf (floor-number-now my-lift) floor-number)))))

slime下的測試結果:

注：lisp文件中用 #| 和 |# 進行塊註釋。

lift-up和lift-down能夠簡寫爲一個宏，往後再補全吧。