(and export
(list* (symbolicate code '-inst)
(symbolicate 'make- code '-inst)
- (mapcan (lambda (arg)
- (let ((sym (if (listp arg) (car arg) arg)))
- (cond ((char= (char (symbol-name sym) 0) #\&)
- nil)
- (t
- (list (symbolicate 'inst- sym))))))
- args)))))
+ (labels ((dig (tree path)
+ (if (or (atom tree) (null path)) tree
+ (dig (nth (car path) tree) (cdr path))))
+ (cook (arg)
+ (if (consp arg) (car arg)
+ (let ((name (symbol-name arg)))
+ (if (char= (char name 0) #\%)
+ (intern (subseq name 1))
+ arg))))
+ (instify (arg)
+ (symbolicate 'inst- (cook arg))))
+ (loop with state = :mandatory
+ for arg in args
+ if (and (symbolp arg)
+ (char= (char (symbol-name arg) 0) #\&))
+ do (setf state arg)
+ else if (member state '(:mandatory &rest))
+ collect (instify arg)
+ else if (member state '(&optional &aux))
+ collect (instify (dig arg '(0)))
+ else if (eq state '&key)
+ collect (instify (dig arg '(0 1)))
+ else
+ do (error "Confused by ~S." arg)))))))
(defmethod form-list-exports ((head (eql 'sod::define-tagged-type)) tail)
(destructuring-bind (kind what) tail
(t (best-package-name pkg)))
(or exportp (null pkg)) (symbol-name symbol))))
+(deftype interesting-class ()
+ '(or standard-class
+ structure-class
+ #.(class-name (class-of (find-class 'condition)))))
+
(defun analyse-classes (package)
(setf package (find-package package))
(let ((classes (mapcan (lambda (symbol)
(let ((class (find-class symbol nil)))
(and class
- (typep class '(or standard-class
- structure-class))
+ (typep class 'interesting-class)
(list class))))
(list-exported-symbols package)))
(subs (make-hash-table)))
(parser-files (files (by-name sod "parser")))
(utilities (by-name sod "utilities"))
(sod-frontend (asdf:find-system "sod-frontend"))
- (optparse (by-name sod-frontend "optparse"))
+ (optparse (by-name sod "optparse"))
(frontend (by-name sod-frontend "frontend"))
- (sod-files (set-difference (files sod) (list utilities))))
+ (sod-files (set-difference (files sod) (list optparse utilities))))
(report-symbols (mapcar #'file-name sod-files) "SOD")
(report-symbols (mapcar #'file-name (list frontend)) "SOD-FRONTEND")
(report-symbols (mapcar #'file-name parser-files) "SOD-PARSER")