Question

(defstruct (mydate (:constructor make-mydate (year month day)))
  (year 1970)
  (month 1)
  (day 1))

 (defvar *date1* (make-mydate 1992 1 1))

问题更为笼统，但我想将像 date1 这样的对象转换为“文档”，我可以将其保存到数据库（例如mongoDB，使用包cl-mongo）。所以我写了

(defun mydate->document (mydate)
   (cl-mongo:$ (cl-mongo:$ "year" (mydate-year mydate))
               (cl-mongo:$ "month" (mydate-month mydate))
               (cl-mongo:$ "day" (mydate-day mydate))))

REPL--> (mydate->doc *date1*)
kv-container : #(#S(CL-MONGO::PAIR :KEY year :VALUE 1992)
                 #S(CL-MONGO::PAIR :KEY month :VALUE 1)
                 #S(CL-MONGO::PAIR :KEY day :VALUE 1))

但是，我可以而不是必须写下我的结构的所有字段，以编程方式获取其名称和值吗？毕竟，我的lisp运行时可以做到这一点：

REPL--> (describe *date1*)
#S(MYDATE :YEAR 1992 :MONTH 1 :DAY 1)
  [structure-object]

Slots with :INSTANCE allocation:
YEAR   = 1992
MONTH  = 1
DAY    = 1

另一方面，我没有在任何书中找到任何相关内容，我注意到库cl-json无法将结构转换为JSON格式（即使它确实转换了列表和CLOS对象）。我想如果有一个函数将结构转换为plist，问题就会解决。

Answer 1

您要找的是Meta-Object Protocol。 Common lisp pioneered MOP，但仅适用于CLOS对象，不适用于defstruct个对象。一些CL实现支持defstruct MOP，但不是全部，您可以使用以下方法检查：

(defstruct s a)
(slot-definition-initargs (car (class-direct-slots (find-class 's))))

Answer 2

没有可移植的方式。

实现以不同方式执行。可能大多数人都有办法访问插槽的名称。我不清楚为什么标准中缺少这样的功能。

LispWorks例如：

(structure:structure-class-slot-names (find-class 'some-structure-class))

也许某处已经存在兼容性库。 CLOS的元对象协议功能也适用于结构类。

SBCL：

* (sb-mop:class-slots (find-class 'foo))

(#<SB-PCL::STRUCTURE-EFFECTIVE-SLOT-DEFINITION A>
 #<SB-PCL::STRUCTURE-EFFECTIVE-SLOT-DEFINITION B>)

* (mapcar 'sb-mop:slot-definition-name *)

(A B)

Answer 3

这是SBCL特定的：

在REPL中可以做到这一点：

(struct-to-list '(NIL #S(N :V 78) #S(OP :V #\*)
 #S(E :V1 #S(N :V 456) :OP #S(OP :V #\+) :V2 #S(N :V 123))))

这将给出结果=>

(NIL
 ((N (V 78))
  ((OP (V #\*)) ((E (V1 (N (V 456))) (OP (OP (V #\+))) (V2 (N (V 123)))) NIL))))

使用的代码：

(defun struct-names (struct)
  (loop for sl in (sb-mop::class-direct-slots (class-of struct))
        collect (list
                 (sb-mop:slot-definition-name sl)
                 (slot-value sl 'sb-pcl::internal-reader-function))))

(defun struct-values (struct)
  (cons (type-of struct)
        (loop for np in (struct-names struct)
              collect (cons (car np)
                            (funcall (cadr np) struct)))))

(defun structp (val)
  (equalp 'STRUCTURE-OBJECT
          (sb-mop:class-name (car (sb-mop:class-direct-superclasses (class-of val))))))

(defun struct-to-list (val)
  (cond
    ((structp val)
     (loop for v in (struct-values val)
           collect (struct-to-list v)))
    ((consp val)
     (cons (struct-to-list (car val))
           (struct-to-list (cdr val))))
    (T val)))

常见的LISP：将（未知）struct对象转换为plist？

3 个答案: