2012-03-16 26 views
8

Có cách nào ngắn để xuất tất cả các biểu tượng từ một gói hay đó là cách duy nhất để thực hiện nó trong defpackage. Tôi thường viết mã của tôi trong một file foo.lisp mà thường bắt đầu với (in-package :foo) và đặt định nghĩa gói vào một tập tin package.lisp mà thường liên quan đến một cái gì đó như thế này:Các biểu tượng xuất khẩu Lisp phổ biến từ các gói

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

Câu hỏi của tôi là: Thiết kế đơn giản là một giao diện sử dụng một số biến toàn cục và đôi khi các hàm có thể không đầy đủ và bạn phải xuất một số cấu trúc. Trong trường hợp này, nếu bạn không đơn giản xuất các hàm truy cập của cấu trúc này, bạn không thể thao tác các đối tượng của các cấu trúc này. Vì vậy, có một cách dễ dàng để hoàn thành hiệu ứng này mà không cần xuất thủ công tất cả các chức năng truy cập này?

Trả lời

9

Một khi các gói được tạo ra, và tất cả các biểu tượng trong nó tạo ra, ví dụ, bằng cách tải mã của bạn mà thực hiện gói, bạn có thể export bất kỳ biểu tượng mà bạn thích, ví dụ, để xuất khẩu tất cả:

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

Bạn có thể sẽ hạnh phúc hơn với

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

sẽ không thử xuất lại mọi thứ từ các gói đã sử dụng.

4

Đánh giá mã macro đã mở rộng, tôi nhận được lỗi cho số cuối cùng trong biểu mẫu phân lớp nếu không có tùy chọn lớp nào được cung cấp và lỗi bổ sung khi biểu tượng hàm xuất phải được trích dẫn. Đây là một phiên bản sửa chữa mà dường như để làm việc trên hệ thống lisp chung của tôi (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)) 
+0

Thực sự tử tế! Tôi không bao giờ có thể nghĩ rằng để thêm và tiêu thụ một khe (: xuất khẩu) trong định nghĩa khe cắm tiêu chuẩn CLOS. –

3

bài Vsevolod của cảm hứng cho tôi để viết vĩ mô cũng như:

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

Cách sử dụng:

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> 

Điều này không được kiểm tra tốt và tôi vẫn đang học API MOP, vì vậy có thể có nhiều cách tốt hơn/sạch hơn để đạt được mục tiêu tương tự ở đây (đặc biệt là fludp kludge). Ngoài ra, điều này chỉ tìm kiếm các hàm truy cập trên một lớp. Ngoài ra còn có các phương pháp chuyên về một lớp. Bạn có thể sử dụng MOP để tìm những người đó ...

Các vấn đề liên quan