将两个变量组合成宏中的一个函数名

Question

我正在玩macros和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 person name p1) which then would return the name.

那么问题就是人和名字(人名)的绑定以及如何做到这一点.反正有没有将这两个参数绑定在宏中？有点像:

(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用a 调用north-american-person,但是你不能north-american-person-name用任何东西调用.(iv)这似乎是在重新考虑时隙价值.您已经可以使用插槽的名称来访问插槽的值(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))

正如雷纳指出,这是不是非常有用的.对于大多数情况,它是相同的

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

除了你可以(funcall #'object …)和(apply #'object …)功能,但你不能与宏.

你的获取宏实际上并不比slot-value更有用 ,它接受一个对象和一个插槽的名称.它不需要类的名称,即使该类没有读者或访问者,它也会起作用.

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

我一直在使用连接和符号名创建符号名称.有时您会看到人们使用格式来构造名称,例如(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}>.

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

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"