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))

我的问题是：有时仅使用一些全局变量和函数的简单接口可能不足够，你需要导出一些结构体。当这种情况发生时，如果你不仅仅导出这个结构体的访问器函数，你将无法操作这些结构体的对象。那么，在不手动导出所有这些访问器函数的情况下，是否有一种简单的方法来实现这种效果？

- oakenshield1

Answer 1

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

(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))))

这样就不会尝试重新导出所使用的包中的所有内容。

- Doug Currie

---

当然，人们可以得出这样的结论，即像 defstruct 这样的宏缺少一个功能。也就是说，缺少一个开关来启用自动导出它们所创建的访问器等。 - BitTickler

它似乎还会从函数内部导出局部变量。这个问题能修复吗？它不应该放在(eval-when (...) ...)块中吗？ - BitTickler

Answer 2

在评估宏扩展代码时，如果没有提供类选项，则在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))

- Vsevolod Dyomkin

---

真不错！我从未想过在标准CLOS slot定义中添加和使用(:export)槽。 - Clayton Stanley

Answer 3

受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来查找它们...

- Clayton Stanley

Answer 4

写导出定义是一项繁琐的任务 - 特别是涉及结构体时。虽然，正如其他答案所示，可能有更复杂的方法，但以下是我通常的做法：

• 编写包和实现，包定义中的(: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)))))))

- BitTickler

Answer 5

有一种方法是使用 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))))

- Ehvince