lisp,CLOS:向流程类添加一个槽

时间:2013-06-08 19:00:04

标签: process common-lisp slots clos

我的程序在多线程中遇到错误,因此我想扩展带有锁定的宏来跟踪进程获取的堆栈。我想通过简单地添加一个槽来处理以存储锁栈来实现这一点。

不幸的是,我不明白如何在运行时添加插槽而不破坏已有的插槽。 ensure-class完全重新定义了类。我不想要这个,因为我不知道其他插槽流程已经有了什么。

如何添加插槽? 特别是,我想添加这两个插槽:

    (lock-stack :documentation "stores a list of all locks of the process.
Only used for debugging"
    :type list
    :initform nil
    :accessor lock-stack-acc
)
(lock-stack-error-found :documentation "indicates that an error on the locks was already found.
Only used for debugging"
    :type boolean
    :initform nil
    :accessor lock-stack-error-found-acc
)

1 个答案:

答案 0 :(得分:1)

GoogleGroups上有人将我与答案联系起来: https://groups.google.com/group/comp.lang.lisp/msg/7e24e8417cd1b6e6?dmode=source

(defun direct-slot-defn->initarg (slot-defn)
  (list :name (slot-definition-name slot-defn)
        :readers (slot-definition-readers slot-defn)
        :writers (slot-definition-writers slot-defn)
        :initform (slot-definition-initform slot-defn)
        :initargs (slot-definition-initargs slot-defn)
        :initfunction (slot-definition-initfunction slot-defn)))

(defun add-slot-to-class (class name &key (initform nil)
                                accessors readers writers
                                initargs
                                (initfunction (constantly nil)))
  (check-type class symbol)
  (let ((new-slots (list (list :name name
                               :readers (union accessors readers)
                               :writers (union writers
                                               (mapcar #'(lambda (x)
                                                           (list 'setf
x))
                                                       accessors)
                                               :test #'equal)
                               :initform initform
                               :initargs initargs
                               :initfunction initfunction))))
    (dolist (slot-defn (class-direct-slots (find-class class)))
      (push (direct-slot-defn->initarg slot-defn)
            new-slots))
    (ensure-class class :direct-slots new-slots)))