macros - 在 Common Lisp 中，编写定义类的宏的最佳方法是什么？

Question

我正在尝试在 Common Lisp 中编写一个宏，它定义一个具有我指定的变体槽的类。到目前为止，一切正常(clisp 给我留下了深刻的印象!):

(defmacro notifier (class slot) 
  "Defines a setf method in (class) for (slot) which calls the object's changed method."
   `(defmethod (setf ,slot) (val (item ,class))
     (setf (slot-value item ',slot) val)
     (changed item ',slot)))

(defmacro notifiers (class slots)
  "Defines setf methods in (class) for all of (slots) which call the object's changed method."
  `(progn 
     ,@(loop for s in slots collecting `(notifier ,class ,s))))

(defmacro defclass-notifier-slots (class nslots slots)
  "Defines a class with (nslots) giving a list of slots created with notifiers, and (slots) giving a list of slots created with regular accessors."
  `(progn
     (defclass ,class () 
       ( ,@(loop for s in nslots collecting `(,s :reader ,s)) 
         ,@(loop for s in slots collecting `(,s :accessor ,s))))
     (notifiers ,class ,nslots)))

问题是，现在我想要创建的不仅仅是我在宏调用中指定的插槽，还有一些其他具有变体名称的插槽。为了做到这一点，我必须使用一个丑陋的“符号名称，改变字符串，实习生”序列来生成变体名称作为插槽名称，并且我已经看到了答案，说你应该避免这样做那。那么有更好的方法吗？

Answer 1

在宏或其辅助函数之一中构造新符号没有任何问题。

每当您多次需要某项内容或需要以某种方式记录它时，请编写一个函数。

由于我们需要使用可能的新符号，因此确保该符号位于正确的包中是有意义的。这里我们假设前缀符号的包是正确的包。

(defun make-suffix-symbol (prefix suffix)
  (check-type prefix symbol)
  (check-type suffix (or string symbol))
  (when (symbolp suffix)
    (setf suffix (symbol-name suffix)))
  (intern (concatenate 'string
                       (symbol-name prefix)
                       suffix)
          (symbol-package prefix)))

CL-USER 12 > (make-suffix-symbol 'http-user::foo "BAR")
HTTP-USER::FOOBAR

或使用格式:

(defun make-suffix-symbol (prefix suffix &optional (format-string "~A~A"))
   (check-type prefix symbol)
   (check-type suffix (or string symbol))
   (when (symbolp suffix)
     (setf suffix (symbol-name suffix)))
   (intern (format nil
                   format-string
                   (symbol-name prefix)
                   suffix)
           (symbol-package prefix)))

CL-USER 14 > (make-suffix-symbol 'http-user::foo "BAR" "~a-~a")
HTTP-USER::FOO-BAR