Common Lisp exporting symbols from packages

前端 未结 4 2077
甜味超标
甜味超标 2021-02-13 05:40

Is there a short way of exporting all the symbols from a package or is it the only way to do it in defpackage. I generally write my code in a file foo.lisp

4条回答
  •  长发绾君心
    2021-02-13 06:06

    Evaluating the macroexpanded code, I get an error for the last nil in the defclass form if no class option is supplied and additional errors as the symbols of the export function have to be quoted. Here is a corrected version which seems to work on my common lisp system (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))
    

提交回复
热议问题