#+cmu #:mop
#+sbcl #:sb-mop))
+;; 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)))
+;;;--------------------------------------------------------------------------
+;;; Miscelleneous utilities.
+
(defun symbolicate (&rest things)
+ "Concatenate the THINGS and turn the result into a symbol."
(intern (apply #'concatenate 'string (mapcar #'string things))))
+;;;--------------------------------------------------------------------------
+;;; Determining the symbols exported by particular files.
+
(defun incomprehensible-form (head tail)
+ "Report an incomprehensible form (HEAD . TAIL)."
(format *error-output* ";; incomprehensible: ~S~%" (cons head tail)))
(defgeneric form-list-exports (head tail)
+ (:documentation
+ "Return a list of symbols exported by the form (HEAD . TAIL).
+
+ This is called from `form-exports' below.")
(:method (head tail)
+ "By default, a form exports nothing."
(declare (ignore head tail))
nil))
(defmethod form-list-exports ((head (eql 'cl:export)) tail)
+ "Return the symbols exported by a toplevel `export' form.
+
+ We can cope with (export 'SYMBOLS), where SYMBOLS is a symbol or a list."
+
(let ((symbols (car tail)))
(if (and (consp symbols)
(eq (car symbols) 'quote))
(incomprehensible-form head tail))))
(defmethod form-list-exports ((head (eql 'sod:definst)) tail)
+ "Return the symbols exported by a `form-list-exports' form.
+
+ The syntax is:
+
+ (definst CODE (STREAMVAR [[:export FLAG]]) ARGS
+ FORM*)
+
+ If FLAG is non-nil, then we export `CODE-inst', `make-CODE-inst', and
+ `inst-ARG' for each argument ARG in the lambda-list ARGS. There are some
+ quirks in this lambda-list:
+
+ * If we find a list (PUBLIC PRIVATE) where we expected an argument-name
+ symbol (but not a list), then the argument is PUBLIC. (PRIVATE is
+ used to name a slot in the class created by the macro, presumably
+ because PUBLIC on its own is a public symbol in some package.)
+
+ * If we find a symbol %NAME, this means the same as the list (NAME
+ %NAME), only we recognize it even where the lambda-list syntax expects
+ a list."
+
(destructuring-bind (code (streamvar &key export) args &body body) tail
(declare (ignore streamvar body))
+
(and export
(list* (symbolicate code '-inst)
(symbolicate 'make- code '-inst)
+
(labels ((dig (tree path)
+ ;; Dig down into a TREE, following the PATH. Stop
+ ;; when we find an atom, or reach the end of the
+ ;; path.
(if (or (atom tree) (null path)) tree
(dig (nth (car path) tree) (cdr path))))
(cook (arg)
+ ;; Convert an ARG name which might start with `%'.
(if (consp arg) (car arg)
(let ((name (symbol-name arg)))
(if (char= (char name 0) #\%)
(intern (subseq name 1))
arg))))
(instify (arg)
+ ;; Convert ARG name into the `inst-ARG' accessor.
(symbolicate 'inst- (cook arg))))
+
+ ;; Work through the lambda-list, keeping track of where we
+ ;; expect the argument symbols to be.
(loop with state = :mandatory
for arg in args
if (and (symbolp arg)
do (error "Confused by ~S." arg)))))))
(defmethod form-list-exports ((head (eql 'sod::define-tagged-type)) tail)
+ "Return the symbols exported by a `define-tagged-type' form.
+
+ This is a scummy internal macro in `c-types-impl.lisp'. The syntax is
+
+ (define-tagged-type KIND DESCRIPTION)
+
+ It exports `KIND' and `make-KIND'."
+
(destructuring-bind (kind what) tail
(declare (ignore what))
(list kind
(symbolicate 'make- kind '-type))))
(defmethod form-list-exports ((head (eql 'sod:defctype)) tail)
+ "Return the symbols exported by a `defctype' form.
+
+ The syntax is:
+
+ (defctype {NAME | (NAME SYNONYM*)} VALUE [[:export FLAG]])
+
+ If FLAG is non-nil, this form exports `c-type-NAME', `NAME', and all of
+ the `SYNONYM's."
+
(destructuring-bind (names value &key export) tail
(declare (ignore value))
(let ((names (if (listp names) names (list names))))
(list* (symbolicate 'c-type- (car names)) names)))))
(defmethod form-list-exports ((head (eql 'sod:define-simple-c-type)) tail)
+ "Return the symbols exported by a `define-simple-c-type' form.
+
+ The syntax is:
+
+ (define-simple-c-type {NAME | (NAME SYNONYM*)} TYPE [[:export FLAG]])
+
+ If FLAG is non-nil, this form exports `c-type-NAME', `NAME', and all of
+ the `SYNONYM's."
+
(destructuring-bind (names type &key export) tail
(declare (ignore type))
(let ((names (if (listp names) names (list names))))
(list* (symbolicate 'c-type- (car names)) names)))))
(defmethod form-list-exports ((head (eql 'cl:macrolet)) tail)
+ "Return the symbols expored by a toplevel `macrolet' form.
+
+ Which are simply the symbols exported by its body."
(mapcan #'form-exports (cdr tail)))
(defmethod form-list-exports ((head (eql 'cl:eval-when)) tail)
+ "Return the symbols expored by a toplevel `eval-when' form.
+
+ Which are simply the symbols exported by its body."
+
+ ;; We don't bother checking when it'd actually be evaluated.
(mapcan #'form-exports (cdr tail)))
(defmethod form-list-exports ((head (eql 'cl:progn)) tail)
+ "Return the symbols expored by a toplevel `progn' form.
+
+ Which are simply the symbols exported by its body."
(mapcan #'form-exports tail))
(defgeneric form-exports (form)
+ (:documentation
+ "Return a list of symbols exported by a toplevel FORM.")
(:method (form) nil)
(:method ((form cons)) (form-list-exports (car form) (cdr form))))
-(defgeneric list-exports (thing))
+(defgeneric list-exports (thing)
+ (:documentation
+ "Return a list of symbols exported by THING."))
(defmethod list-exports ((stream stream))
+ "Return a list of symbols exported by a STREAM.
+
+ By reading it and analysing the forms."
+
(loop with eof = '#:eof
for form = (read stream nil eof)
until (eq form eof)
when (consp form) nconc (form-exports form)))
(defmethod list-exports ((path pathname))
+ "Return a list of symbols exported by a directory PATHNAME.
+
+ Return an alist of pairs (PATH . SYMBOL) listing each SYMBOL exported by a
+ PATH of the form PATHNAME/*.lisp."
+
(mapcar (lambda (each)
(cons each (with-open-file (stream each) (list-exports stream))))
(directory (merge-pathnames path #p"*.lisp"))))
(defmethod list-exports ((path string))
+ "Return a list of symbols exported by a PATH string.
+
+ By converting it into a pathname."
+
(list-exports (pathname path)))
(defun list-exported-symbols (package)
+ "Return a sorted list of symbols exported by PACKAGE."
(sort (loop for s being the external-symbols of package collect s)
#'string< :key #'symbol-name))
(defun list-all-symbols (package)
+ "Return a sorted list of all symbols exported by or private to PACKAGE."
(let ((externs (make-hash-table)))
(dolist (sym (list-exported-symbols package))
(setf (gethash sym externs) t))
#'string< :key #'symbol-name)))
(defun find-symbol-homes (paths package)
+ "Determine the `home' file for the symbols exported by PACKAGE.
+
+ Return an alist of pairs (PATH . SYMBOL) listing each SYMBOL exported by a
+ PATH of the form PATHNAME/*.lisp where PATHNAME is a member of PATHS. Do
+ this by finding all the files and parsing them (somewhat superficially),
+ and cross-checking the result against the actual symbols exported by the
+ PACKAGE."
+
+ ;; Building the alist is exactly what `list-exports' is for. The rest of
+ ;; this function is the cross-checking.
(let* ((symbols (list-exported-symbols package))
(exports-alist (let ((*package* package))
(mapcan #'list-exports paths)))
(homes (make-hash-table :test #'equal)))
+
+ ;; Work through the alist recording where we found each symbol. Check
+ ;; that they're actually exported by poking at the package.
(dolist (assoc exports-alist)
(let ((home (car assoc)))
(dolist (symbol (cdr assoc))
(unless (nth-value 1 (find-symbol name package))
(format *error-output* ";; unexported: ~S~%" symbol))
(setf (gethash name homes) home)))))
+
+ ;; Check that all of the symbols exported by the package are accounted
+ ;; for in our alist.
(dolist (symbol symbols)
(unless (gethash (symbol-name symbol) homes)
(format *error-output* ";; mysterious: ~S~%" symbol)))
+
+ ;; We're done.
exports-alist))
+;;;--------------------------------------------------------------------------
+;;; Determining the kinds of definitions attached to symbols.
+
(defun boring-setf-expansion-p (symbol)
+ "Return non-nil if SYMBOL has a trivial `setf' expansion.
+
+ i.e., (setf (SYMBOL ...) ...) works by (funcall #'(setf SYMBOL) ...)."
+
(multiple-value-bind (temps args stores store fetch)
(ignore-errors (get-setf-expansion (list symbol)))
(declare (ignore temps args stores fetch))
(eq (car func) 'setf))))))
(defun specialized-on-p (func arg what)
+ "Check whether FUNC has a method specialized for the symbol WHAT.
+
+ We assume FUNC is a (well-known) generic function. ARG is a small integer
+ identifying one of FUNC's mandatory arguments. Return non-nil if FUNC has
+ a method for which this ARG is `eql'-specialized on WHAT."
+
(some (lambda (method)
(let ((spec (nth arg (method-specializers method))))
(and (typep spec 'eql-specializer)
(generic-function-methods func)))
(defun categorize (symbol)
+ "Determine what things SYMBOL is defined to do.
+
+ Return a list of keywords:
+
+ * :constant -- SYMBOL's value cell is `boundp' and `constantp'
+ * :variable -- SYMBOL's value cell is `boundp' but not `constantp'
+ * :macro -- SYMBOL's function cell is `macro-function'
+ * :generic -- SYMBOL's function cell is a `generic-function'
+ * :function -- SYMBOL's function cell is a non-generic `function'
+ * :setf-generic -- (setf SYMBOL) is a `generic-function'
+ * :setf-function -- (setf SYMBOL) is a non-generic `function'
+ * :class -- SYMBOL is `find-class'
+ * :c-type -- `expand-c-type-spec' or `expand-c-type-form' has a method
+ specialized on SYMBOL
+ * :parser -- `expand-parser-spec' or `expand-parser-form' has a method
+ specialized on SYMBOL
+ * :opthandler -- SYMBOL has an `opthandler' property
+ * :optmacro -- SYMBOL has an `optmacro' property
+
+ categorizing the kinds of definitions that SYMBOL has."
+
(let ((things nil))
(when (boundp symbol)
(push (if (constantp symbol) :constant :variable) things))
(nreverse things)))
(defun categorize-symbols (paths package)
+ "Return a categorized list of the symbols exported by PACKAGE.
+
+ Return an alist of PAIRS (PATH . SYMBOLS), for each PATH in PATHS, where
+ SYMBOLS is itself an alist (SYMBOL . KEYWORDS) listing the kinds of
+ definitions that SYMBOL has (see `categorize')."
(mapcar (lambda (assoc)
(let ((home (car assoc))
(symbols (delete-duplicates
(cons home (mapcar (lambda (symbol)
(cons symbol (categorize symbol)))
symbols))))
-
(find-symbol-homes paths package)))
+;;;--------------------------------------------------------------------------
+;;; Reporting.
+
(defun best-package-name (package)
+ "Return a convenient name for PACKAGE."
;; We pick the shortest one. Strangely, there's no `find minimal thing
;; according to this valuation' function in Common Lisp.
(defvar charbuf-size 0)
(defun exported-symbol-p (symbol &optional (package (symbol-package symbol)))
+ "Return whether SYMBOL is exported by PACKAGE.
+
+ PACKAGE default's to the SYMBOL's home package, but may be different."
(and package
(multiple-value-bind (sym how)
(find-symbol (symbol-name symbol) package)
(eq how :external)))))
(defun downcase-or-escape (name)
+ "Return a presentable form for a symbol or package name.
+
+ If NAME consists only of uppercase letters and ordinary punctuation, then
+ return NAME in lowercase; otherwise wrap it in `|...|' and escape as
+ necessary."
+
(if (every (lambda (char)
(or (upper-case-p char)
(digit-char-p char)
(write-char #\| out))))
(defun pretty-symbol-name (symbol package)
+ "Return a presentable form for SYMBOL, relative to PACKAGE.
+
+ If SYMBOL is exported by PACKAGE then just write the SYMBOL's name
+ otherwise prefix the name with the SYMBOL's home package name, separated
+ joined with one or two colons. Uninterned symbols and keywords are also
+ printed specially."
+
(let ((pkg (symbol-package symbol))
(exportp (exported-symbol-p symbol)))
(format nil "~:[~A:~:[:~;~]~;~2*~]~A"
(downcase-or-escape (symbol-name symbol)))))
(deftype interesting-class ()
+ "The type of `interesting' classes, which might be user-defined."
'(or standard-class
structure-class
#.(class-name (class-of (find-class 'condition)))))
(defun analyse-classes (package)
+ "Print a report on the classes defined by PACKAGE."
+
+ ;; Canonify PACKAGE into a package object.
(setf package (find-package package))
+
(let ((classes (mapcan (lambda (symbol)
(let ((class (find-class symbol nil)))
(and class
(list class))))
(list-exported-symbols package)))
(subs (make-hash-table)))
+ ;; CLASSES is a list of the `interesting' classes defined by (i.e., whose
+ ;; names are exported by) PACKAGE. SUBS maps a class to those of its
+ ;; direct subclasses which are relevant to our report.
+
+ ;; Populate the SUBS table.
(let ((done (make-hash-table)))
(labels ((walk-up (class)
(unless (gethash class done)
(setf (gethash class done) t))))
(dolist (class classes)
(walk-up class))))
+
(labels ((walk-down (this super depth)
+ ;; Recursively traverse the class graph from THIS, recalling
+ ;; that our parent is SUPER, and that we are DEPTH levels
+ ;; down.
+
(format t "~v,0T~A~@[ [~{~A~^ ~}]~]~%"
(* 2 depth)
(pretty-symbol-name (class-name this) package)
(dolist (sub (sort (copy-list (gethash this subs))
#'string< :key #'class-name))
(walk-down sub this (1+ depth)))))
+
+ ;; Print the relevant fragment of the class graph.
(walk-down (find-class t) nil 0))))
(defmacro deep-compare ((left right) &body body)
+ "Helper macro for traversing two similar objects in parallel.
+
+ Specifically it's good at defining complex structural ordering relations,
+ answering the question: is the LEFT value strictly less than the RIGHT
+ value.
+
+ Evaluate the BODY forms, maintaining a pair of `cursors', initially at the
+ LEFT and RIGHT values.
+
+ The following local macros are defined to do useful things.
+
+ * (focus EXPR . BODY) -- EXPR is an expression in terms of `it': advance
+ each of the cursors to the result of evaluating this expression, with
+ `it' bound to the current cursor value, and evaluate the BODY in the
+ resulting environment.
+
+ * (update EXPR) -- as `focus', but mutate the cursors rather than
+ binding them.
+
+ * (compare EXPR) -- EXPR is an expression in terms of the literal
+ symbols `left' and `right', which returns non-nil if it thinks `left'
+ is (strictly) less than `right' in some sense: evaluate this both ways
+ round, and return if LEFT is determined to be less than or greater
+ than RIGHT.
+
+ * (typesw (TYPE . BODY)*) -- process each clause in turn: if the left
+ cursor value has TYPE, but the right does not, then LEFT is less than
+ RIGHT; if the right cursor value has TYPE but the left does not, then
+ LEFT is greater than RIGHT; otherwise, evaluate BODY."
+
(let ((block (gensym "BLOCK-")) (func (gensym "FUNC-"))
(l (gensym "LEFT-")) (r (gensym "RIGHT-")))
`(macrolet ((focus (expr &body body)
,@body)))))
(defun order-specializers (la lb)
+ "Return whether specializers LA should be sorted before LB."
+
(deep-compare (la lb)
- (loop (typesw (null (return nil)))
- (focus (car it)
- (typesw (eql-specializer
- (focus (eql-specializer-object it)
- (typesw (keyword
- (compare (string< left right)))
- (symbol
- (focus (package-name (symbol-package it))
- (compare (string< left right)))
- (compare (string< left right)))
- (t
- (focus (with-output-to-string (out)
- (prin1 it out)
- (write-char #\nul))
- (compare (string< left right)))))))
- (class
- (focus (class-name it)
- (focus (package-name (symbol-package it))
- (compare (string< left right)))
- (compare (string< left right))))
- (t
- (error "unexpected things"))))
- (update (cdr it)))))
+ ;; Iterate over the two lists. The cursors advance down the spine, and
+ ;; we focus on each car in turn.
+
+ (loop
+ (typesw (null (return nil)))
+ ;; If one list reaches the end, then it's lesser; if both, they're
+ ;; equal.
+
+ (focus (car it)
+ ;; Examine the two specializers at this position.
+
+ (typesw (eql-specializer
+ (focus (eql-specializer-object it)
+ ;; We found an `eql' specializer. Compare the objects.
+
+ (typesw (keyword
+ ;; Keywords compare by name.
+
+ (compare (string< left right)))
+
+ (symbol
+ ;; Symbols compare by package and name.
+
+ (focus (package-name (symbol-package it))
+ (compare (string< left right)))
+ (compare (string< left right)))
+
+ (t
+ ;; Compare two other objects by comparing their
+ ;; string representations.
+
+ (focus (with-output-to-string (out)
+ (prin1 it out)
+ (write-char #\nul))
+ (compare (string< left right)))))))
+
+ (class
+ ;; We found a class, Compare the class names.
+ (focus (class-name it)
+ (focus (package-name (symbol-package it))
+ (compare (string< left right)))
+ (compare (string< left right))))
+
+ (t
+ ;; We found some other kind of specializer that we don't
+ ;; understand.
+
+ (error "unexpected things"))))
+
+ ;; No joy with that pair of specializers: try the next.
+ (update (cdr it)))))
(defun analyse-generic-functions (package)
+ "Print a report of the generic functions and methods defined by PACKAGE."
+
+ ;; Canonify package into a package object.
(setf package (find-package package))
+
(flet ((function-name-core (name)
+ ;; Return the underlying name for a function NAME. Specifically,
+ ;; if NAME is (setf THING) then the core is THING; if NAME is a
+ ;; symbol then the core is simply NAME; otherwise we're confused.
+ ;; Return a second value to say whether we got the job done.
+
(typecase name
(symbol (values name t))
((cons (eql setf) t) (values (cadr name) t))
(t (values nil nil)))))
+
(let ((methods (make-hash-table))
(functions (make-hash-table))
(externs (make-hash-table)))
+ ;; EXTERNS is a set of the symbols exported by PACKAGE. FUNCTIONS and
+ ;; METHODS are sets of generic function names (not cores), and method
+ ;; objects, which we've decided are worth reporting.
+
+ ;; Collect the EXTERNS symbols.
(dolist (symbol (list-exported-symbols package))
(setf (gethash symbol externs) t))
+
+ ;; Collect the FUNCTIONS and METHODS.
(dolist (symbol (list-exported-symbols package))
+
+ ;; Mark the generic functions and `setf'-functions named by exported
+ ;; symbols as interesting, along with all of their methods.
(flet ((dofunc (func)
(when (typep func 'generic-function)
(setf (gethash func functions) t)
(setf (gethash method methods) t)))))
(dofunc (and (fboundp symbol) (fdefinition symbol)))
(dofunc (ignore-errors (fdefinition (list 'setf symbol)))))
+
+ ;; For symbols whose home package is PACKAGE, and which name a class,
+ ;; also collect functions with methods specialized on that class, and
+ ;; (only) the specialized methods.
(when (eq (symbol-package symbol) package)
(let ((class (find-class symbol nil)))
(when class
- (dolist
- (func (specializer-direct-generic-functions class))
+ (dolist (func (specializer-direct-generic-functions class))
(multiple-value-bind (name knownp)
(function-name-core (generic-function-name func))
(when (and knownp
(setf (gethash func functions) t)
(dolist (method (specializer-direct-methods class))
(setf (gethash method methods) t)))))))))
+
+ ;; Print the report.
(let ((funclist nil))
+
+ ;; Gather the functions we've decided are interesting, and sort them.
(maphash (lambda (func value)
(declare (ignore value))
(push func funclist))
functions)
(setf funclist (sort funclist
(lambda (a b)
+ ;; Sort by the core symbols, and order the
+ ;; `setf' variant after the base version.
(let ((core-a (function-name-core a))
(core-b (function-name-core b)))
(if (eq core-a core-b)
(and (atom a) (consp b))
(string< core-a core-b))))
:key #'generic-function-name))
+
(dolist (function funclist)
+ ;; Print out each function in turn.
+
+ ;; Print the header line.
(let ((name (generic-function-name function)))
(etypecase name
(symbol
((cons (eql setf) t)
(format t "(setf ~A)~%"
(pretty-symbol-name (cadr name) package)))))
+
+ ;; Report on the function's (interesting) methods.
(dolist (method (sort (copy-list
(generic-function-methods function))
#'order-specializers
:key #'method-specializers))
+
(when (gethash method methods)
(format t "~2T~{~A~^ ~}~@[ [~{~(~S~)~^ ~}]~]~%"
(mapcar
(method-qualifiers method)))))))))
(defun check-slot-names (package)
+ "Check that PACKAGE defines no slots whose names are exported symbols.
+
+ This acts to discourage the use of `slot-value' by external callers.
+ Return two values:
+
+ * an alist of entries (CLASS . SLOT-NAMES), listing for each offending
+ class, whose of its slot names which are either (a) external or (b)
+ from a foreign package; and
+
+ * the distilled list of bad SLOT-NAMES."
+
+ ;; Canonify PACKAGE into a package objects.
(setf package (find-package package))
+
(let* ((symbols (list-all-symbols package))
+
+ ;; Determine all of the named classes.
(classes (mapcan (lambda (symbol)
(when (eq (symbol-package symbol) package)
(let ((class (find-class symbol nil)))
(and class (list class)))))
symbols))
+
+ ;; Build the main alist of offending classes and slots.
(offenders (mapcan
(lambda (class)
(let* ((slot-names
(list (cons (class-name class)
exported)))))
classes))
+
+ ;; Distill the bad slot names into a separate list.
(bad-words (remove-duplicates (mapcan (lambda (list)
(copy-list (cdr list)))
offenders))))
+
+ ;; Done.
(values offenders bad-words)))
(defun report-symbols (paths package)
+ "Report on all of the symbols defined in PACKAGE by the files in PATHS."
+
+ ;; Canonify PACKAGE to a package object.
(setf package (find-package package))
+
+ ;; Print the breakdown of symbols by source file, with their purposes.
(format t "~A~%Package `~(~A~)'~2%"
(make-string 77 :initial-element #\-)
(package-name package))
(pretty-symbol-name sym package)
(cdr def))))
(terpri)))
+
+ ;; Report on leaked slot names, if any are exported or foreign.
(multiple-value-bind (alist names) (check-slot-names package)
(when names
(format t "Leaked slot names: ~{~A~^, ~}~%"
(mapcar (lambda (name) (pretty-symbol-name name package))
(cdr assoc))))
(terpri)))
+
+ ;; Report on classes and generic functions.
(format t "Classes:~%")
(analyse-classes package)
(terpri)
(export 'report-project-symbols)
(defun report-project-symbols ()
+ "Write to `*standard-output*' a report on all of the symbols in Sod."
+
(labels ((components (comp)
+ ;; Return the subcomponents of an ASDF component.
+
(asdf:component-children comp))
+
(files (comp)
+ ;; Return a list of files needed by an ASDF component.
+
(sort (remove-if-not (lambda (comp)
(typep comp 'asdf:cl-source-file))
(components comp))
#'string< :key #'asdf:component-name))
+
(by-name (comp name)
+ ;; Find the subcomponent called NAME of an ASDF component.
+
(gethash name (asdf:component-children-by-name comp)))
+
(file-name (file)
+ ;; Return the pathname of an ASDF file component.
+
(slot-value file 'asdf/component:absolute-pathname)))
+
(let* ((sod (asdf:find-system "sod"))
(parser-files (files (by-name sod "parser")))
(utilities (by-name sod "utilities"))
(optparse (by-name sod "optparse"))
(frontend (by-name sod-frontend "frontend"))
(sod-files (set-difference (files sod) (list optparse utilities))))
+
+ ;; Report on the various major pieces of the project.
(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")
(report-symbols (mapcar #'file-name (list optparse)) "OPTPARSE")
(report-symbols (mapcar #'file-name (list utilities)) "SOD-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
(report-project-symbols)))
#+interactive (main)
+
+;;;----- That's all, folks --------------------------------------------------
~mdw / sod / commitdiff