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

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

9
common-lisp export

3 ответов

Как только пакет создан, и все символы в нем созданы, например, загрузив свой код, который реализует пакет, вы можете экспорт любые символы, которые вам нравятся, например, экспортировать все:

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

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

10

оценивая макрорасширенный код, я получаю ошибку для последнего нуля в форме 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))
4

сообщение Всеволода вдохновило меня также опубликовать макрос:

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

3