macros - 在宏中将两个变量合并为一个函数名

Question

我在玩弄宏和 clos，在那里我创建了一个“对象”宏来创建实例

(defmacro object (class &rest args)
  `(make-instance ',class ,@args))

现在这样做，我最终也有点想为 clos 创建的访问器函数做一些类似的事情。示例:

(defclass person () ((name :accessor person-name :initarg :name)))

然后创建实例

(setf p1 (object person :name "tom"))

现在要从对象中获取名称，显然我会调用 person-name，但是就像对象宏一样，我想创建一个“gets”宏来执行此操作。所以理想情况下:

(gets person name p1) which then would return the name.

接下来的问题是person和name(person-name)的绑定(bind)以及如何绑定(bind)。有没有办法在宏中将这两个参数绑定(bind)在一起？有点像:

(defmacro gets (class var object)
  `(,class-,var ,object))

Answer 1

我想我可能误解了原意。起初我以为你在问如何为类定义生成访问器名称，答案的第三部分解决了这个问题。第二次阅读后，听起来您实际上想要生成一个新符号并用一些参数调用它。这也很容易，并在本答案的第二部分给出。第二部分和第三部分都取决于能够创建一个符号，该符号的名称是根据其他符号的名称构建的，这就是我们的起点。

“连接”符号

每个符号都有一个名称(字符串)，您可以使用 symbol-name 获得该名称.您可以使用 concatenate从一些旧字符串创建一个新字符串，然后使用 intern获取具有新名称的符号。

(intern (concatenate 'string
                     (symbol-name 'person)
                     "-"
                     (symbol-name 'name)))
;=> PERSON-NAME

重构访问者名称

(defmacro gets (class-name slot-name object)
  (let ((accessor-name 
         (intern (concatenate 'string
                              (symbol-name class-name)
                              "-"
                              (symbol-name slot-name))
                 (symbol-package class-name))))
    `(,accessor-name ,object)))

(macroexpand-1 '(gets person name some-person))
;=> (PERSON-NAME SOME-PERSON)

但是，出于多种原因，这不是很可靠。 (i) 您不知道插槽是否具有 <class-name>-<slot-name> 形式的访问器. (ii) 即使插槽确实具有 <class-name>-<slot-name> 形式的访问器，你不知道它在什么包里。在上面的代码中，我做了一个合理的假设，它和类名的包是一样的，但这根本不是必需的。例如，您可以:

(defclass a:person ()
  ((b:name :accessor c:person-name)))

然后这种方法根本行不通。 (iii) 这不适用于继承。如果你继承person , 用 north-american-person 说, 那么您仍然可以调用 person-name用north-american-person , 但你不能调用 north-american-person-name与任何东西。 (iv) 这似乎是在重新发明 slot-value .您已经可以通过 (slot-value object slot-name) 单独使用槽的名称来访问槽的值。 ，而且我看不出有任何理由表明您的 gets宏不应该只是扩展到那个。在那里，您不必担心访问器的特定名称(如果它有的话)，或类名的包，而只需担心插槽的实际名称。

生成访问器名称

您只需要提取符号的名称并生成具有所需名称的新符号即可。
如果你想自动生成具有 defstruct 样式名称的访问器，你可以这样做:

(defmacro define-class (name direct-superclasses slots &rest options)
  (flet ((%slot (slot)
           (destructuring-bind (slot-name &rest options) 
               (if (listp slot) slot (list slot))
             `(,slot-name ,@options :accessor ,(intern (concatenate 'string
                                                                    (symbol-name name)
                                                                    "-"
                                                                    (symbol-name slot-name)))))))
    `(defclass ,name ,direct-superclasses
       ,(mapcar #'%slot slots)
       ,@options)))

您可以通过查看宏展开来检查这是否产生了您期望的代码类型:

(pprint (macroexpand-1 '(define-class person ()
                         ((name :type string :initarg :name)
                          (age :type integer :initarg :age)
                          home))))

(DEFCLASS PERSON NIL
          ((NAME :TYPE STRING :INITARG :NAME :ACCESSOR PERSON-NAME)
           (AGE :TYPE INTEGER :INITARG :AGE :ACCESSOR PERSON-AGE)
           (HOME :ACCESSOR PERSON-HOME)))

我们可以看到它按预期工作:

(define-class person ()
  ((name :type string :initarg :name)
   (age :type integer :initarg :age)
   home))

(person-name (make-instance 'person :name "John"))
;=> "John"

对您代码的其他评论

(defmacro object (class &rest args)
  `(make-instance ',class ,@args))

作为Rainer pointed out这不是很有用。对于大多数情况，它与

相同

(defun object (class &rest args)
  (apply 'make-instance class args))

除了你可以 (funcall #'object …)和 (apply #'object …)使用函数，但不能使用宏。

您的 gets 宏实际上并不比 slot-value 更有用。 ，它接受一个对象和一个插槽的名称。它不需要类的名称，即使类没有读取器或访问器，它也能正常工作。

不要(天真地)用 format 创建符号名称

我一直在用 concatenate 和 symbol-name 创建符号名称。有时您会看到人们使用格式来构造名称，例如 (format nil "~A-~A" 'person 'name) ，但这很容易出现可以更改的大写设置问题。例如，在下面，我们定义了一个函数 foo-bar，并注意到基于格式的方法失败了，但是基于连接的方法有效。

CL-USER> (defun foo-bar ()
           (print 'hello))
FOO-BAR
CL-USER> (foo-bar)

HELLO 
HELLO
CL-USER> (setf *print-case* :capitalize)
:Capitalize
CL-USER> (funcall (intern (concatenate 'string (symbol-name 'foo) "-" (symbol-name 'bar))))

Hello 
Hello
CL-USER> (format nil "~a-~a" 'foo 'bar)
"Foo-Bar"
CL-USER> (intern (format nil "~a-~a" 'foo 'bar))
|Foo-Bar|
Nil
CL-USER> (funcall (intern (format nil "~a-~a" 'foo 'bar)))
; Evaluation aborted on #<Undefined-Function Foo-Bar {1002BF8AF1}>.

这里的问题是我们没有保留参数的符号名称的大小写。为了保留大小写，我们需要显式提取符号名称，而不是让打印函数将符号名称映射到其他字符串。为了说明问题，请考虑:

CL-USER> (setf (readtable-case *readtable*) :preserve)
PRESERVE

;; The symbol-names of foo and bar are "foo" and "bar", but 
;; you're upcasing them, so you end up with the name "FOO-BAR".
CL-USER> (FORMAT NIL "~{~A~^-~}" (MAPCAR 'STRING-UPCASE '(foo bar)))
"FOO-BAR"

;; If you just concatenate their symbol-names, though, you
;; end up with "foo-bar".
CL-USER> (CONCATENATE 'STRING (SYMBOL-NAME 'foo) "-" (SYMBOL-NAME 'bar))
"foo-bar"

;; You can map symbol-name instead of string-upcase, though, and 
;; then you'll get the desired result, "foo-bar"
CL-USER> (FORMAT NIL "~{~A~^-~}" (MAPCAR 'SYMBOL-NAME '(foo bar)))
"foo-bar"