defstruct 宏構造對象比 defclass 構造宏在定義對象時要明顯簡單，因爲 defstruct 實現了常用的構造方法，比較 make-instance ,print-object,字段 reader and writer等等，可以大幅提高編碼效率，另一方面 前段時間在構造二叉樹時，發現 struct 不能用來方便存儲左右支村，因爲defstruct 定義的對象在顯示(print)時會展開代碼，構成了循環引用棧溢出，所以最後只好改爲了defclass定義節點，後來考慮改造defclass宏，使之實現類型defstruct特性，便有了隨後的實驗性實現宏 define-class。
define-class 宏特性：
1、類似defstruct定義對象
2、支持class繼承
3、添加 make-class-name 函數包裝 make-instance 調用；實現 print-obj打印對象；slot 同名的 reader and writer 默認實現.
4、支持檢索類的 父類，slots，及slot default value
(defpackage :WHJ.DEFCLASS
(:use
:common-lisp
:ext)
(:export
:define-class
:print-obj
:make-fn-call-list
:as-keyword
:as-list
:get-class-field-list))
(in-package :WHJ.DEFCLASS)
(defgeneric print-obj (obj))
(defmethod print-obj :after (obj)
(declare (ignore obj))
(format t "--------------------------~%"))
(defun as-keyword (s)
(intern (string s) :keyword))
(defun as-list (s)
(if (listp s) s (list s)))
(defun as-class-field-list (field)
(let* ((f (as-list field))
(f-name (car f))
(f-val (cadr f)))
(list f-name
:initarg (as-keyword f-name)
:initform f-val
:accessor f-name)))
(defun make-fn-call-list (&rest fn-list)
(labels ((fn (fn-list x)
(unless fn-list (return-from fn x))
(fn (cdr fn-list) (funcall (car fn-list) x))))
(lambda (x) (fn fn-list x))))
(defun get-class-field-list (class)
(let ((lst (get class :super-class-list))
(field-list (get class :slots-default-values)))
(append field-list
(if lst (reduce #'append (mapcar #'get-class-field-list lst))))))
(defmacro define-class (class-name (&rest super-class-list) &rest field-list)
(eval-when (:compile-toplevel :load-toplevel :execute)
(setf (get class-name :slots) (mapcar (make-fn-call-list #'as-list #'car) field-list) ;:slots
(get class-name :super-class-list) super-class-list ;:super-class-list
(get class-name :slots-default-values) (mapcar #'as-list field-list)));:slots-default-values
`(progn
;defclass class-name
(defclass ,class-name ,super-class-list
,(mapcar #'as-class-field-list field-list))
;defun make-class-name
(defun ,(intern (string-concat "MAKE-" (string class-name))) (&key ,@(get-class-field-list class-name))
(make-instance ',class-name ,@(mapcan (lambda (x) (list (as-keyword (car x)) (car x))) (get-class-field-list class-name))))
;demethod print-obj
(defmethod print-obj ((obj ,class-name))
(format t "~a values:~%" ',class-name)
,@(loop for k in (get class-name :slots) collect `(format t "~8t~a:~a~%" ',k (,k obj)))
(when (get ',class-name :super-class-list) ;if exits super-class-list then call-next-method
(call-next-method)))))
(defun test-1 nil
(define-class whj-test nil k1 k2 k3 (k4 4) (k5 5))
(let ((b (make-instance 'whj-test)))
(print-obj b)))
(defun test-2 nil
(define-class base nil (m 1) (n 2))
(define-class driver (base) (k1 11) k2 (k3 33))
(let ((a (make-instance 'base)) (b (make-instance 'driver :k2 "ok.test")))
(print-obj a)
(terpri)
(print-obj b)))