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下的测试结果: