Common Lisp экспортирует символы из пакетов - PullRequest
Новая
       19

Common Lisp экспортирует символы из пакетов

11 голосов
/ 16 марта 2012

Есть ли короткий способ экспорта всех символов из пакета или это единственный способ сделать это в 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))

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

Ответы [ 3 ]

12 голосов
/ 16 марта 2012

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

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

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

4 голосов
/ 17 марта 2012

Оценивая макрорасширенный код, я получаю сообщение об ошибке для последнего 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 голосов
/ 17 марта 2012

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

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

...