Common Lisp 从包中导出符号

Question

有没有一种从包中导出所有符号的捷径，或者它是在defpackage 中实现它的唯一方法。我通常将我的代码写入文件foo.lisp，该文件通常以(in-package :foo) 开头，并将包定义放入文件package.lisp，这通常涉及以下内容：

(in-package :cl-user)

(defpackage :foo
  (:use :cl)
  (:documentation "Bla bla bla."
  (:export :*global-var-1*
           :*global-var-2*
           :function-1
           :function-2
           :struct
           :struct-accessor-fun-1
           :struct-accessor-fun-2
           :struct-accessor-fun-3
           :struct-accessor-fun-4))

我的问题是：使用一些全局变量和函数来简单地设计一个接口有时可能是不够的，你必须导出一些结构。在这种情况下，如果您不简单地导出此结构的访问器函数，则无法操作这些结构的对象。那么，有没有一种简单的方法可以在不手动导出所有这些访问器函数的情况下实现这种效果？

Answer 1

编写导出定义是一件苦差事——尤其是在涉及结构的情况下。 虽然 - 正如其他答案所示，可以有更复杂的方法， 这是我通常做的：

• 编写包和实现，包定义中的(:export) 列表为空。
• 然后，我调用我的小助手函数，它以复制和粘贴友好的方式列出包中的所有 fboundp 符号。
• 然后，我将辅助函数的输出复制到包定义的 (:export) 部分，并删除我不想想要导出的所有行。

这是我的小助手函数，它也使用了一些已接受的答案。

(defun show-all-fboundp-symbols-of-package
    (package-name
     &optional (stream t))
  (let ((pack (find-package package-name)))
    (do-all-symbols (sym pack)
      (when (eql (symbol-package sym) pack)
        (when (fboundp sym)
          (format stream ":~A~%" (symbol-name sym)))))))

Answer 2

cl-annot 包有一种方法。它的export-slots、export-accessors、export-constructors 允许自动导出它们。它适用于类和结构。

例如，

@export-accessors
(defclass foo ()
     ((bar :reader bar-of)
      (bax :writer bax-of)
      (baz :accessor baz-of)))

等价于

(progn
  (export '(bar-of bax-of baz-of))
  (defclass foo ()
     ((bar :reader bar-of)
      (bax :writer bax-of)
      (baz :accessor baz-of))))

Answer 3

评估宏扩展代码时，如果没有提供类选项，我会在 defclass 表单中的最后一个 nil 出现错误，并且必须引用导出函数的符号等其他错误。这是一个更正的版本，似乎可以在我的通用 lisp 系统 (sbcl) 上运行：

(defmacro def-exporting-class (name (&rest superclasses) (&rest slot-specs)
                               &optional class-option)
  (let ((exports (mapcan (lambda (spec)
                           (when (getf (cdr spec) :export)
                             (let ((name (or (getf (cdr spec) :accessor)
                                             (getf (cdr spec) :reader)
                                             (getf (cdr spec) :writer))))
                               (when name (list name)))))
                         slot-specs)))
    `(progn
       (defclass ,name (,@superclasses)
         ,(append 
           (mapcar (lambda (spec)
                     (let ((export-pos (position :export spec)))
                       (if export-pos
                       (append (subseq spec 0 export-pos)
                           (subseq spec (+ 2 export-pos)))
                       spec)))
               slot-specs)
           (when class-option (list class-option))))
       ,@(mapcar (lambda (name) `(export ',name))
                 exports))))


(macroexpand-1
 '(def-exporting-class test1 nil
   ((test-1 :accessor test-1 :export t)
    (test-2 :initform 1 :reader test-2 :export t)
    (test-3 :export t))))

(PROGN
 (DEFCLASS TEST1 NIL
           ((TEST-1 :ACCESSOR TEST-1) (TEST-2 :INITFORM 1 :READER TEST-2)
            (TEST-3)))
 (EXPORT 'TEST-1)
 (EXPORT 'TEST-2))

Answer 4

Vsevolod 的帖子也启发了我发布宏：

(defmacro defpackage! (package &body options)
  (let* ((classes (mapcan 
                    (lambda (x) 
                      (when (eq (car x) :export-from-classes)
                        (cdr x)))
                    options))
         (class-objs (mapcar #'closer-common-lisp:find-class classes))
         (class-slots (mapcan #'closer-mop:class-slots class-objs))
         (slot-names (mapcar #'closer-mop:slot-definition-name class-slots))
         (slots-with-accessors
           (remove-duplicates (remove-if-not #'fboundp slot-names))))
    (setf options (mapcar
                    (lambda (option)
                      (if (eq (car option) :export)
                        (append option 
                                (mapcar #'symbol-name slots-with-accessors))
                        option))
                    options))
    (setf options (remove-if 
                    (lambda (option)
                      (eq (car option) :export-from-classes))
                    options))
    `(defpackage ,package ,@options)))

使用方法：

CL-USER> 
(defclass test-class ()
  ((amethod :accessor amethod :initarg :amethod :initform 0)
   (bmethod :reader bmethod :initform 1)))
#<STANDARD-CLASS TEST-CLASS>
CL-USER> 
(closer-mop:ensure-finalized  (find-class 'test-class))
#<STANDARD-CLASS TEST-CLASS>
CL-USER> 
(macroexpand-1 
  `(defpackage! test-package
     (:export "symbol1")
     (:export-from-classes test-class)))
(DEFPACKAGE TEST-PACKAGE
  (:EXPORT "symbol1" "AMETHOD" "BMETHOD"))
T
CL-USER> 

这没有经过很好的测试，而且我还在学习 MOP API，所以这里可能有更好/更简洁的方法来实现相同的目标（尤其是 fboundp kludge）。此外，这仅在类上查找访问器函数。还有一些专门针对某个类的方法。您也可以使用 MOP 来查找这些...

Answer 5

一旦创建了包，并创建了其中的所有符号，例如，通过加载实现包的代码，您可以export任何您喜欢的符号，例如，导出所有：

(do-all-symbols (sym (find-package :foo)) (export sym))

你可能会更快乐

(let ((pack (find-package :foo)))
  (do-all-symbols (sym pack) (when (eql (symbol-package sym) pack) (export sym))))

它不会尝试从使用过的包中重新导出所有内容。