Общий 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))

Мой вопрос: проектирование просто интерфейса, использующего некоторые глобальные переменные и функции, может быть некорректным иногда, и вам нужно экспортировать некоторые структуры. Если это так, если вы не просто экспортируете функции доступа этой структуры, вы не можете манипулировать объектами этой структуры. Итак, есть ли простой способ для достижения этого эффекта без ручного экспорта всех этих функций доступа?

Ответ 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))))

который не будет пытаться реэкспортировать все из используемых пакетов.

Ответ 2

Оценивая макрорасширенный код, я получаю сообщение об ошибке для последнего nil в форме defclass, если не указан параметр класса, и дополнительные ошибки, поскольку символы функции экспорта должны быть указаны. Вот исправленная версия, которая, похоже, работает на моей общей системе 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))

Ответ 3

Всеволодский пост вдохновил меня на публикацию макроса:

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

Это не очень хорошо протестировано, и я все еще изучаю API MOP, поэтому здесь могут быть намного лучшие/более чистые способы достижения той же цели (особенно fludp kludge). Кроме того, это только ищет функции доступа к классу. Существуют также методы, которые специализируются на классе. Вы также можете использовать MOP, чтобы найти их...

Ответ 4

Есть способ с пакетом 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))))