lisp, CLOS: добавление слота в класс процесса

Question

Моя программа получает ошибки с многопоточностью, поэтому я хочу расширить макрос с захватом блокировки, чтобы отслеживать стек блокировок, которые получает процесс. Я хочу сделать это, просто добавив слот в процесс для хранения стека блокировки.

К сожалению, я не понимаю, как добавить слот во время выполнения, не разрушая то, что уже есть. Обеспечение класса полностью переопределяет класс. Я не хочу этого, так как я не знаю, какой процесс у других слотов уже есть.

Как я могу добавить слот? В частности, я хотел бы добавить эти два слота:

    (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
)

Answer 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)))

Answer 2

CLOS обеспечивает функциюchange-classкоторый предоставляет способ добавления слотов через наследование следующим образом:

      ;; clog-web-content is the class provided by the framework
;; it does not provide a constructor, but can be created by a factory function
;; => class mixin does not work

;; my solution:
;; extend the class by inheritance
(defclass cmd-section (clog-web-content)
  ((form :accessor form :type clog-form)
   (label :accessor label :type clog-label)
   (text :accessor text :type clog-form-element))) 

;; change the subtype back to the framework type for later usage
;; of framework functions on this type:
(defmethod create-cmd-section (body)
  (let ((cmd-section (create-web-content body)))
    (change-class cmd-section 'cmd-section)
    (with-slots (form label text)
        cmd-section
      (setf form (create-form cmd-section))
      (setf label (create-label form
                                :content "Enter command"))
      (setf text (create-form-element form :text
                                      :class "w3-input w3-border"
                                      :label label)))
    cmd-section))

Я предполагаю, что это решение может быть полезно и в других случаях.