14.1 クラスの実現

Next: 14.2 メソッドの実現 Up: 14 オブジェクト指向機能の実現 Previous: 14 オブジェクト指向機能の実現

14.1 クラスの実現

クラスを表現するために構造体を用いる．構造体の要素にはクラスを表現するために必要なデータを蓄えるためのものを用意しておく．ここでは，クラスの名前(name)，インスタンス変数(local-variables)，メソッド表(functions)，親クラス(parent)がある．


(defvar *verbose* t)
;;;
(defstruct class
  (name nil)
  (local-variables nil)
  (functions (make-hash-table))
  (parent nil))
;;;
(defvar *all-classes* nil)
;;;
(defparameter object 'object)
;;;
(defun initialize-class-system ()
  (if *all-classes* (clrhash *all-classes*)
    (setf *all-classes* (make-hash-table)))
  (setf (gethash object *all-classes*)
        (make-class :name object))
  (defmethod object
    (:local-vars
     ()
     (mapcar
      #'local-var
      (class-local-variables
       (get-class (send self 'class)))))
    )
  )

クラスを定義するdefclassが行なうことは，クラスの構造体データをひとつ作り，それを大域変数*all-classes*に代入されているハッシュ表にクラス名をキーにして蓄える．


(defmacro defclass
  (class-name &key ((:super s) object) slots)
  `(progn
     (defparameter ,class-name ',class-name)
     (define-class ',class-name ',s ',slots)))

(defun defined-class? (class-name)
  (gethash class-name *all-classes*))

(defun define-class (class-name parent local-vars)
  (let* ((locals
          (get-all-local-vars
           (if parent parent object) local-vars))
         (class
          (make-class
           :name class-name
           :parent (or parent object)
           :local-variables locals
           :functions
           (if (defined-class? class-name)
               (class-functions (get-class class-name))
             (make-hash-table)))))
    (store-class class-name class)))
(defun store-class (class-name class)
  (if *verbose* 
      (format t "; class ~a defined under ~a.~%"
              class-name (class-parent class)))
  (setf (gethash class-name *all-classes*) class))
;;;
(defun local-var (loc-var)
  (if (atom loc-var) loc-var (car loc-var)))
(defun get-all-local-vars (parent loc-vars)
  (remove-duplicates
   (append (class-local-variables (get-class parent))
           loc-vars)
   :key #'local-var))
;;;
(defun get-class (class-name)
  (cond
   ((gethash class-name *all-classes*))
   (t (error "~a is an undefined class" class-name))))

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