-#! /bin/sh
-":"; ### -*-lisp-*-
-":"; CL_SOURCE_REGISTRY=$(pwd)/build/src/:; export CL_SOURCE_REGISTRY
-":"; exec cl-launch -X -l "sbcl cmucl" -s asdf -i "(sod-exports::main)" -- "$0" "$@" || exit 1
+#! /usr/bin/runlisp -Lsbcl,cmucl
+;;; -*-lisp-*-
(cl:defpackage #:sod-exports
(:use #:common-lisp
;; Load the target system so that we can poke about in it.
(cl:in-package #:sod-exports)
(eval-when (:compile-toplevel :load-toplevel :execute)
- (mapc #'asdf:load-system '(:sod :sod-frontend)))
+ (asdf:clear-configuration)
+ (mapc #'asdf:load-system '(:sod :sod/frontend)))
;;;--------------------------------------------------------------------------
;;; Miscelleneous utilities.
(and export
(list* (symbolicate 'c-type- (car names)) names)))))
+(defmethod form-list-exports
+ ((head (eql 'sod::define-cross-product-types)) tail)
+ "Return the symbols exported by a `define-cross-product-types' form.
+
+ This is a scummy internal macro in `c-types-impl.lisp'. The syntax is
+
+ (define-cross-product-types PIECES)
+
+ Each piece can be a list of strings, or an atomic string (which is
+ equivalent to a list containing just that string). For each string formed
+ by concatenating one element from each list in order, define a C type with
+ that name; the Lisp name is constructed by translating the letters to
+ uppercase and replacing underscores by hyphens. For each such name,
+ export `NAME' and `c-type-NAME'."
+
+ ;; Huh. I feel a hack coming on.
+ (mapcar (lambda (row)
+ (intern (with-output-to-string (out)
+ (dolist (s row)
+ (dotimes (i (length s))
+ (let ((ch (char s i)))
+ (if (char= ch #\_)
+ (write-char #\- out)
+ (write-char (char-upcase ch) out))))))))
+ (reduce (lambda (piece tails)
+ (mapcan (lambda (tail)
+ (mapcar (lambda (head)
+ (cons head tail))
+ (if (listp piece) piece
+ (list piece))))
+ tails))
+ (cons '("" "c-type_") tail)
+ :from-end t
+ :initial-value '(nil))))
+
+
(defmethod form-list-exports ((head (eql 'cl:macrolet)) tail)
"Return the symbols expored by a toplevel `macrolet' form.
categorizing the kinds of definitions that SYMBOL has."
(let ((things nil))
- (when (boundp symbol)
+ (when (or (boundp symbol) (documentation symbol 'variable))
(push (if (constantp symbol) :constant :variable) things))
- (when (fboundp symbol)
+ (when (or (fboundp symbol) (documentation symbol 'function))
(push (cond ((macro-function symbol) :macro)
((typep (fdefinition symbol) 'generic-function)
:generic)
(generic-function (push :setf-generic things))
(function (push :setf-function things))
(null)))
- (when (find-class symbol nil)
- (push :class things))
- (when (or (specialized-on-p #'sod:expand-c-type-spec 0 symbol)
- (specialized-on-p #'sod:expand-c-type-form 0 symbol))
- (push :c-type things))
- (when (or (specialized-on-p #'sod-parser:expand-parser-spec 1 symbol)
- (specialized-on-p #'sod-parser:expand-parser-form 1 symbol))
- (push :parser things))
- (when (get symbol 'optparse::opthandler)
+ (when (or (find-class symbol nil) (documentation symbol 'type))
+ (push (if (find-class symbol nil) :class :type) things))
+ (when (specialized-on-p #'sod:expand-c-type-spec 0 symbol)
+ (push :c-type-spec things))
+ (when (specialized-on-p #'sod:expand-c-type-form 0 symbol)
+ (push :c-type-form things))
+ (when (specialized-on-p #'sod:expand-c-storage-specifier 0 symbol)
+ (push :c-storage-spec things))
+ (when (specialized-on-p #'sod:expand-c-storage-specifier-form 0 symbol)
+ (push :c-storage-form things))
+ (when (specialized-on-p #'sod-parser:expand-parser-spec 1 symbol)
+ (push :parser-spec things))
+ (when (specialized-on-p #'sod-parser:expand-parser-form 1 symbol)
+ (push :parser-form things))
+ (when (get symbol 'optparse::opthandler-function)
(push :opthandler things))
- (when (get symbol 'optparse::optmacro)
+ (when (get symbol 'optparse::optmacro-function)
(push :optmacro things))
(nreverse things)))
(let* ((sod (asdf:find-system "sod"))
(parser-files (files (by-name sod "parser")))
(utilities (by-name sod "utilities"))
- (sod-frontend (asdf:find-system "sod-frontend"))
+ (sod-frontend (asdf:find-system "sod/frontend"))
(optparse (by-name sod "optparse"))
(frontend (by-name sod-frontend "frontend"))
(sod-files (set-difference (files sod) (list optparse utilities))))
;;; Command-line use.
(defun main ()
- "Write a report to `doc/SYMBOLS'."
- (with-open-file (*standard-output* #p"doc/SYMBOLS"
- :direction :output
- :if-exists :supersede
- :if-does-not-exist :create)
- (report-project-symbols)))
-
-#+interactive (main)
+ "Write a report to *standard-output*."
+ (report-project-symbols))
+
+#+runlisp-script (main)
;;;----- That's all, folks --------------------------------------------------