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

时间：2014-06-26 14:21:35

标签： macros common-lisp clisp

我正在玩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))

4 个答案:

答案 0 :(得分：8)

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

“连接”符号

每个符号都有一个名称（字符串），您可以使用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 …)使用该功能，但不能使用该宏。

你的获取宏实际上并不比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"

答案 1 :(得分：0)

如果您希望gets使用访问者方法：

(defmacro gets (class var object)
  `(,(intern (format nil "~a-~a" (symbol-name class) (symbol-name var))) ,object))

一般来说，你想要完成的事情并没有真正有用。 make-instance是一个众所周知的符号，容易可以使用，是标准的一部分，并且在类名称不变时通过某些实现进行优化。因此，使用object宏，您只需保存一些字符和单引号。通常，在您不希望提供初始化实例的直接方式的特定情况下，隐藏make-instance，或者更有可能，当您想要提供初始化层时（例如，初始化阶段，Lisp插槽和异物）。

PS：我清楚地记得，在Common Lisp标准化中突出的人认为总是包裹/隐藏make-instance在一个函数中（例如make-<class-name>），但是我无法找到参考或推理。

PPS：Here's a rather old discussion (2004) about it in comp.lang.lisp（and another one from 2002）。人们引用建构函数的主要原因是：

  1. 必填参数;可以在运行时实现，而不是在编译时使用:initform (error ...)在需要提供初始值的插槽中实现

  2. 通常，隐藏实现细节：类实例，结构实例，缺点，其他

    2.1。不想导出实际的类名

    2.2。能够返回其他类的实例，通常是子类

  3. 特定班级的便捷速记

    4. 我总是总是，因为似乎CLOS对象的构造函数的支持者不一定要隐藏make-instance所遵循的协议（allocate-instance，{ {1}}→initialize-instance）API或框架的实施者或扩展者，尽管他们可能希望将其隐藏到API或框架的使用者。

    对于更快的内容，您可能希望直接访问插槽，但这并不使用访问器方法，因此不支持副作用，例如： shared-initialize和:before方法：

    :after

    这可能是某些实现的直接插槽访问。

    最后，标准中还有with-slots和with-accessors。

答案 2 :(得分：0)

此功能从string designators创建符号：

(defun symb (&rest args)
  (intern (format nil "~{~a~^-~}" (mapcar #'string args))))

该功能使用format，但通过了Joshua's test：

CL-USER> (symb 'foo :bar "BAZ")
FOO-BAR-BAZ
NIL
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 (symb 'foo 'bar))

Hello 
Hello

答案 3 :(得分：-4)

尝试玩这样的东西：

(let ((a 'a)
      (dash '-)
      (b 'b))
 `(,a,dash,b))

其他可能性是使用实习生，或更加用户友好的亚历山大的象征。

相关问题
最新问题