0

我想使用宏来创建一个类实例。

我的意思是我想创建一个像这样的表达式：

(make-instance 'message :id id :mid mid)

我这样定义类。

(defclass message ()
  ((id
     :initarg :id
     :initform 0
     :accessor id)
   (mid
     :initarg :mid
     :initform 0
     :accessor mid)))

(defmethod print-object ((obj message) stream)
   (print-unreadable-object (obj stream :type t)
      (with-slots (id mid) obj
         (format stream "~A  ~A " id mid))))

和这样的宏。

 (defun slotlist (alist)
    (mapcan
       #'(lambda (x)
            (let* ((s (closer-mop:slot-definition-name x))
                   (k (intern (symbol-name s) :keyword))
                   (v (assoc k alist)))
                   (if v (list k (cdr v)))))
                (closer-mop:class-direct-slots (find-class 'message))))

(defmacro create-message (alist)
    (let ((a (gensym)))
       `(let ((,a (slotlist ,alist)))
            (make-instance 'message ,@a))))

和 json-obj 类似：

(setq json-obj '((:id . 1) (:mid . 2)))

当我应用宏创建消息时

(create-message json-obj)

它扩展为：

(LET ((#:G1111 (SLOTLIST JSON-ALIT)))
   (MAKE-INSTANCE 'MESSAGE . #:G1111))

但是实例没有正确初始化，因为它显示实例的值为#

我是否必须拼接 map 函数字符串并使用 apply 函数？

4

5 回答 5

1

也许我错过了关于您的用例的一些重要内容，但在我看来，您想要的东西可以很容易地实现为一个函数。

为了创建一个新message实例，我们需要类似(make-instance 'message :id 1 :mid 2). 所有这些信息都在json-obj里面——我们只需要将它按摩成正确的格式并使用apply:。

(defun json-attr->arg-list (json-attr)
  (list (car json-attr)
        (cdr json-attr)))

(defun json-obj->arg-list (json-obj)
  (apply #'concatenate 'list
         (map 'list #'json-attr->arg-list json-obj)))

(defun create-message (json-obj)
  (apply #'make-instance 'message (json-obj->arg-list json-obj)))

现在，我们可以create-message使用您之前定义的调用json-obj：

=> (create-message json-obj)

#<MESSAGE 1  2 >

现在，我们可以将其实现为宏，但重点是什么？我们无法知道json-objbefore 运行时的值，所以在编译时我们真的无能为力，除了基本上内联我们刚刚编写的函数。但是（a）在这种情况下不太可能将性能提高任何可测量的量，并且（b）这不是宏的用途——使用编译器提示进行内联。

另外，如果您想使用create-message高阶函数，则无论如何都必须将其实现为函数。例如，从 alist 列表(map 'list #'create-message list-of-json-objs)创建对象列表将是一种非常方便的方法。message在 common-lisp 中，一个符号可以同时有一个宏和一个与之关联的函数，因此您可以为它创建宏和函数绑定。但是由于您没有从使用宏中获得任何优势，您所要做的就是为自己创造更多的工作。

于 2013-11-15T18:52:08.737 回答
0

目前尚不清楚您要做什么，所以我不知道您是否应该使用 apply 功能。但是，我可以帮助您解决代码中的一个问题。

在您提供的代码中，您有一个以

`(let ((,insym ,json-obj))

然后，您使用以开头的形式从准引用中逃脱

,(mapcan #'(lambda (x)

你有一个级别的准引用，一个取消引用（逗号）来匹配它。因此，当宏展开时，将评估该表单。但是然后在同一个未引用的表单中，您尝试取消引用另一个表单：

,insym

这是一个错误，因为您已经摆脱了准引用的单级。要修复此错误（尽管可能不是整个宏），您需要删除最后一个逗号。

本文可能有助于了解有关准引用的更多详细信息： http: //repository.readscheme.org/ftp/papers/pepm99/bawden.pdf

于 2013-11-15T03:57:21.667 回答
0

根本问题是，a您在准引用列表中引用的是您在外部绑定的那个let，它扩展为一个 gensym。

让我举一个小例子：

* (let ((b 'a)) `(let ((,b (foo))) (print ,@b)))

(LET ((A (FOO)))
  (PRINT . A))

正如我们所见，b绑定到a，这不是一个列表，所以将它拼接起来，我们最终得到一个点对。

如果我们跳过扩展它，我们会更接近正确。

因此，您可以尝试以下方法之一，而不是您所拥有的：

(defmacro create-message (alist)
    (let ((a (gensym)))
       `(let ((,a (slotlist ,alist)))
            (make-instance 'message ',a))))

或者：

(defmacro create-message (alist)
  `(make-instance 'message (slotlist ,alist)))  ; You may want ',alist
于 2013-11-15T13:16:19.080 回答
0

这是您如何使用以下方法执行此操作的cl-json：

(ql:quickload "cl-json")

(defclass message ()
  ((id :initarg :id :initform 0 :accessor id)
   (mid :initarg :mid :initform 0 :accessor mid)))

(cl-json:encode-json (make-instance 'message :mid 42 :id 13))
{"id":13,"mid":42}

这就是它的全部。您可能想在这里阅读更多内容：http: //common-lisp.net/project/cl-json/#STREAMING-API（文档和 API 一样有点繁琐，但仍然可以为您节省时间花从头开始写）。

顺便说一句：JSON 并不像经常宣传的那么好。如果您可以自由选择格式，请查看 Protobuf 或 Trift（它们也很糟糕，但不如 JSON 糟糕）:)

于 2013-11-16T20:21:47.113 回答
0

问题是宏不知道参数的值，所以它将被视为一个符号。所以在宏的主体中，它将替换符号，而不是符号的值。

,@(slotlist ,alist)

是错误的，因为在 ,@ 的正文中不能包含 , 来获取符号值。如果您使用 ,@(slotlist alist) 符号 alist 将永远不会正确评估，宏将其视为符号。

解决问题的正确方法是使用 eval 函数：

(defmacro create-message (alist)
    `(make-instance 'message ,@(slotlist (eval alist))))
于 2013-11-20T15:01:33.437 回答