Símbolo de exportación de Lisp común de los paquetes

Question

¿Hay alguna forma de exportar todos los símbolos de un paquete o es la única forma de hacerlo en defpackage? Yo por lo general escribo mi código en un archivo foo.lisp que por lo general comienza con (in-package :foo) y poner la definición de paquete en un archivo package.lisp que generalmente involucra algo como esto:

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

Mi pregunta es: Proyectos simplemente una interfaz utilizando algunas variables globales y las funciones pueden no ser adecuadas a veces, y debe exportar algunas estructuras. Cuando este es el caso, si no se exportan simplemente las funciones de acceso de esta estructura, no se pueden manipular los objetos de estas estructuras. Entonces, ¿hay una manera fácil de lograr este efecto sin exportar manualmente todas estas funciones de acceso?

Answer 1

Una vez creado el paquete, y todos los símbolos en ella creados, por ejemplo, mediante la carga de su código que implementa el paquete, puede export cualquier símbolo que te gusta, por ejemplo, para exportar todo:

(do-all-symbols (sym (find-package :foo)) (export sym)) 

Usted Probablemente sea más feliz con

(let ((pack (find-package :foo))) 
    (do-all-symbols (sym pack) (when (eql (symbol-package sym) pack) (export sym)))) 

que no intentarán reexportar todo desde paquetes usados.

Answer 2

Evaluando el código macro expandido, obtengo un error para el último nulo en la forma defclass si no se proporciona ninguna opción de clase y errores adicionales ya que los símbolos de la función de exportación deben ser citados. Aquí es una versión corregida que parece funcionar en mi sistema Common 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

puesto de Vsevolod me inspiró para escribir un macro así:

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

de usar:

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> 

Esto no se ha probado bien, y todavía estoy aprendiendo la API MOP, por lo que puede haber formas mucho mejores/más limpias para lograr el mismo objetivo aquí (especialmente el kludge fboundp). Además, esto solo busca funciones de acceso en una clase. También hay métodos que se especializan en una clase. Podría usar el MOP para encontrar esos también ...