通用Lisp从包导出符号

Question

有没有一种从包中导出所有符号的快捷方法，或者这是在defpackage中唯一的方法。我通常将代码写在一个通常以(in-package :foo)开头的文件foo.lisp中，并将包定义放到一个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任何您喜欢的符号，例如，导出所有：

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

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

Answer 2

评估宏扩展代码时，如果没有提供class选项，我会得到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 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)。此外，这只查找类上的访问器函数。也有专门针对类的方法。你也可以用拖把找到那些...