Common Lisp从包中导出符号

时间:2012-03-16 19:01:52

标签: export common-lisp

是否有一种从包中导出所有符号的简短方法,或者它是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))

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

4 个答案:

答案 0 :(得分:11)

创建包并创建包中的所有符号后,例如,通过加载实现包的代码,您可以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))))

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

答案 1 :(得分:4)

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

答案 2 :(得分: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来找到那些......

答案 3 :(得分:1)

cl-annot包中有一种方法。其export-slotsexport-accessorsexport-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))))