@@@ yet more mess
authorMark Wooding <mdw@distorted.org.uk>
Fri, 13 Aug 2021 18:49:55 +0000 (19:49 +0100)
committerMark Wooding <mdw@distorted.org.uk>
Sun, 15 Aug 2021 08:22:27 +0000 (09:22 +0100)
16 files changed:
.gitignore
COPYING [new symlink]
COPYING.LIB [new symlink]
config/auto-version [new symlink]
config/confsubst [new symlink]
doc/Makefile.am
doc/cmdline.tex [new file with mode: 0644]
m4/mdw-auto-version.m4 [new symlink]
m4/mdw-libtool-version-info.m4 [new symlink]
m4/mdw-silent-rules.m4 [new symlink]
src/frontend.lisp
src/module-output.lisp
src/module-parse.lisp
src/module-proto.lisp
src/optparse.lisp
src/sod.1.in

index 3c673e9..3bd07ad 100644 (file)
 *.blg
 _region_.tex
 Makefile.in
-/COPYING
-/COPYING.LIB
 /aclocal.m4
 /autom4te.cache/
-/config/
+/config/compile
+/config/config.guess
+/config/config.sub
+/config/depcomp
+/config/install-sh
+/config/ltmain.sh
+/config/missing
+/config/test-driver
 /configure
diff --git a/COPYING b/COPYING
new file mode 120000 (symlink)
index 0000000..782bd18
--- /dev/null
+++ b/COPYING
@@ -0,0 +1 @@
+.ext/cfd/licence/GPL-2
\ No newline at end of file
diff --git a/COPYING.LIB b/COPYING.LIB
new file mode 120000 (symlink)
index 0000000..8d44cb9
--- /dev/null
@@ -0,0 +1 @@
+.ext/cfd/licence/LGPL-2
\ No newline at end of file
diff --git a/config/auto-version b/config/auto-version
new file mode 120000 (symlink)
index 0000000..652e105
--- /dev/null
@@ -0,0 +1 @@
+../.ext/cfd/build/auto-version
\ No newline at end of file
diff --git a/config/confsubst b/config/confsubst
new file mode 120000 (symlink)
index 0000000..8e7de22
--- /dev/null
@@ -0,0 +1 @@
+../.ext/cfd/build/confsubst
\ No newline at end of file
index 89484a9..8bb0a8e 100644 (file)
@@ -78,7 +78,7 @@ TEX_FILES             += tutorial.tex
 ## Reference.
 TEX_FILES              += refintro.tex
 TEX_FILES              += concepts.tex
-##TEX_FILES            += cmdline.tex
+TEX_FILES              += cmdline.tex
 TEX_FILES              += syntax.tex
 TEX_FILES              += runtime.tex
 TEX_FILES              += structures.tex
diff --git a/doc/cmdline.tex b/doc/cmdline.tex
new file mode 100644 (file)
index 0000000..299ae9a
--- /dev/null
@@ -0,0 +1,164 @@
+%%% -*-latex-*-
+%%%
+%%% Description of the internal class structure and protocol
+%%%
+%%% (c) 2009 Straylight/Edgeware
+%%%
+
+%%%----- Licensing notice ---------------------------------------------------
+%%%
+%%% This file is part of the Simple Object Definition system.
+%%%
+%%% SOD is free software; you can redistribute it and/or modify
+%%% it under the terms of the GNU General Public License as published by
+%%% the Free Software Foundation; either version 2 of the License, or
+%%% (at your option) any later version.
+%%%
+%%% SOD is distributed in the hope that it will be useful,
+%%% but WITHOUT ANY WARRANTY; without even the implied warranty of
+%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+%%% GNU General Public License for more details.
+%%%
+%%% You should have received a copy of the GNU General Public License
+%%% along with SOD; if not, write to the Free Software Foundation,
+%%% Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+\chapter{Invoking the Sod translator}
+
+%%%--------------------------------------------------------------------------
+\section{Basic principles}
+
+The Sod translator reads a number of source modules named on its command
+line (together with other modules directly or indirectly imported by these),
+and generates output files of the requested types.
+
+%%%--------------------------------------------------------------------------
+\section{Command-line syntax}
+
+The translator is named @|sod|, and is invoked as
+\begin{prog}
+  sod @[@-Mp@] @[@--backtrace@] @[@--builtins@]
+        @[@-I @<dir>@] @[@-d @<dir>@]
+        @[@-e @<lisp>@] @[@-l @<file>@]
+        @[@-t @<out-type>@]
+        @<source> \ldots
+\end{prog}
+
+Options follow the standard POSIX/GNU conventions:
+\begin{itemize}
+
+\item Single-letter options without arguments can be grouped together, so
+  @|@-Mp| means the same as @|@-M @-p|.
+
+\item The argument for a single-letter option can be given either in the
+  following argument word, or, if it is nonempty, in the same argument word
+  immediately following the option letter.  The argument for a GNU-style long
+  option can be given either in the following argument word, or in the same
+  argument word following a @|=|.
+
+\item If the environment variable @|POSIXLY_CORRECT| is set (to any value),
+  then option processing will stop as soon as the first non-option is found.
+  Otherwise, options may be mixed together with positional arguments, and all
+  argument words beginning with @|@-| (other than @|@-| and @|@--|) which
+  aren't option arguments are interpreted as options.
+
+\item The words @|@-| and @|@--| are not options.  The former is treated like
+  any other non-option word.  The latter is a special marker indicating that
+  option processing should stop here: all subsequent argument words are
+  treated as positional arguments regardless of any leading @|@-| characters.
+
+\end{itemize}
+
+Options are processed left-to-right.
+
+\begin{description}
+
+\item[@|@-h|, @|@--help|] Write commad-line help to standard output, and exit
+  successfully.
+\item[@|@-V|, @|@--version|] Write the Sod translator's version number to
+  standard output, and exit successfully.
+\item[@|@-u|, @|@--usage|] Write a (very) brief usage summary to standard
+  output, and exit successfully.
+
+\item[@|@--backtrace|] Report errors through the host Lisp's usual
+  error-handling system, which will typically involve printing a stack
+  backtrace.  By default, the translator prints a short error message and
+  exits, in the manner common to Unix programs.  You may find this option
+  useful for debugging.
+
+\item[@|@-e|, @|@--eval=|@<lisp>] Evaluate the Lisp form(s) in @<lisp>, in
+  order.  Nothing is printed: if you want output, write Lisp to print it.
+  Forms are evaluated in the @|SOD-USER| package.
+\item[@|@-l|, @|@--load=|@<file>] Load and evaluate Lisp code from @<file>.
+  The file is loaded into the @|SOD-USER| package (though obviously
+  @|in-package| forms in the file will be respected).
+
+\item[@|@--builtins|] Generate output for the built-in module, which defines
+  the @|SodObject| and @|SodClass| classes.  The built-in module is named
+  @|sod-base|.  This option is used to build Sod's runtime library, and is
+  probably not useful otherwise.
+
+\item[@|@-I|, @|@--include=|@<dir>] Look for imported modules in @<dir>.
+  This option may be repeated: directories are searched in the order they
+  were named.
+
+\item[@|@-M|, @|@--track-dependencies|] Write a Makefie fragment capturing
+  the dependencies of each emitted output file.
+
+  The details are delegated to output type handlers, but the default file
+  name is the same as the main output, with @`@-dep' appended.
+
+  This option does nothing if @|@-p| is in force.
+
+\item[@|@-d|, @|@--directory=|@<dir>] Write output files to the directory
+  @<dir>, instead of the current directory.  The names of the output files
+  are determined by the names of the input modules and the requested output
+  types.
+
+\item[@|@-p|, @|@--stdout|] Write the generated output to standard output,
+  rather than to files.
+
+\item[@|@-t|, @|@--type=|@<out-type>] Produce output of type @<out-type>.
+  This option can be repeated to generate several output files from the same
+  modules.  The built-in output types are described below.
+
+  More output types can be defined by extensions.  Each @<out-type> is
+  converted into a Lisp keyword @<reason>, by uppercasing it and interning it
+  in the @|keyword| package.  Each requested module is loaded, and then, for
+  each requested @<reason>, an output filename is determined (by calling
+  \descref{gf}{module-output-file}, unless @|@-p| is in force); the output
+  file is generated (using \descref{fun}{output-module}), and, if @|@-M| is
+  in force, a Makefile fragment is written (using
+  \descref{gf}{write-dependency-file}).
+
+\end{description}
+
+%%%--------------------------------------------------------------------------
+\section{Built-in output types}
+
+The following output types are implemented by the base translator.
+Additional types can be provided by extensions.
+
+\begin{description}
+
+\item[@|c|] Write C source, suitable for standalone compilation, defining the
+  necessary direct and effective method functions and static tables for the
+  classes defined in the module.  The output file for a module called @<name>
+  will be @|@<dir>/@<name>.c|, and the dependency file will be
+  @|@<dir>/@<name>.c-dep|.
+
+\item[@|h|] Write a C header file, suitable for inclusion using @|\#include|,
+  declaraing the necessary data structures and functions for the classes
+  defined in the module.  The output file for a module called @<name> will be
+  @|@<dir>/@<name>.h|, and the dependency file will be
+  @|@<dir>/@<name>.h-dep|.
+
+\end{description}
+
+%%%----- That's all, folks --------------------------------------------------
+
+%%% Local variables:
+%%% mode: LaTeX
+%%% TeX-master: "sod.tex"
+%%% TeX-PDF-mode: t
+%%% End:
diff --git a/m4/mdw-auto-version.m4 b/m4/mdw-auto-version.m4
new file mode 120000 (symlink)
index 0000000..db358e4
--- /dev/null
@@ -0,0 +1 @@
+../.ext/cfd/m4/mdw-auto-version.m4
\ No newline at end of file
diff --git a/m4/mdw-libtool-version-info.m4 b/m4/mdw-libtool-version-info.m4
new file mode 120000 (symlink)
index 0000000..3298202
--- /dev/null
@@ -0,0 +1 @@
+../.ext/cfd/m4/mdw-libtool-version-info.m4
\ No newline at end of file
diff --git a/m4/mdw-silent-rules.m4 b/m4/mdw-silent-rules.m4
new file mode 120000 (symlink)
index 0000000..52d11e3
--- /dev/null
@@ -0,0 +1 @@
+../.ext/cfd/m4/mdw-silent-rules.m4
\ No newline at end of file
index 6fb9d2e..a00a8bb 100644 (file)
                     ("Evaluate raw Lisp code.")
                     (lambda (lisp)
                       (handler-case
-                          (let ((*package* (find-package "SOD-USER")))
-                            (eval (read-from-string lisp)))
+                          (let ((*package* (find-package "SOD-USER"))
+                                (token (cons 'token nil)))
+                            (with-input-from-string (in lisp)
+                              (loop (let ((form (read in nil token)))
+                                      (when (eq form token) (return))
+                                      (eval form)))))
                         (error (error)
                           (option-parse-error "~A" error)))))
                (#\l "load" (:arg "FILE")
index d09dfd8..21fcadd 100644 (file)
          ;; filetype case to do that.  Make a pathname and inspect it to
          ;; find out how to do this.
 
-         (if (upper-case-p
-                          (char (pathname-type (make-pathname
-                                                :type "TEST"
-                                                :case :common))
-                                0))
-                         #'string-upcase
-                         #'string-downcase))
+         (if (upper-case-p (char (pathname-type (make-pathname
+                                                 :type "TEST"
+                                                 :case :common))
+                                 0))
+             #'string-upcase
+             #'string-downcase))
 
         (outpath (output-type-pathname reason))
         (deppath (make-pathname :type (concatenate 'string
index eff4af7..43a49ad 100644 (file)
 ;;; External files.
 
 (export 'read-module)
-(defun read-module (pathname &key (truename nil truep) location)
+(defun read-module (pathname &key (truename nil truep) location stream)
   "Parse the file at PATHNAME as a module, returning it.
 
    This is the main entry point for parsing module files.  You may well know
                                  (make-pathname :type "SOD" :case :common)))
   (unless truep (setf truename (truename pathname)))
   (define-module (pathname :location location :truename truename)
-    (with-open-file (f-stream pathname :direction :input)
-      (let* ((char-scanner (make-instance 'charbuf-scanner
-                                         :stream f-stream
-                                         :filename (namestring pathname)))
-            (scanner (make-instance 'sod-token-scanner
-                                    :char-scanner char-scanner)))
-       (with-default-error-location (scanner)
-         (with-parser-context (token-scanner-context :scanner scanner)
-           (multiple-value-bind (result winp consumedp)
-               (parse (skip-many ()
-                         (seq ((pset (parse-property-set scanner))
-                               (nil (error ()
-                                        (plug module scanner pset)
-                                      (skip-until (:keep-end nil)
-                                        #\; #\}))))
-                           (check-unused-properties pset))))
-             (declare (ignore consumedp))
-             (unless winp (syntax-error scanner result)))))))))
+    (flet ((parse (f-stream)
+            (let* ((char-scanner
+                    (make-instance 'charbuf-scanner
+                                   :stream f-stream
+                                   :filename (namestring pathname)))
+                   (scanner (make-instance 'sod-token-scanner
+                                           :char-scanner char-scanner)))
+              (with-default-error-location (scanner)
+                (with-parser-context
+                    (token-scanner-context :scanner scanner)
+                  (multiple-value-bind (result winp consumedp)
+                      (parse (skip-many ()
+                               (seq ((pset (parse-property-set scanner))
+                                     (nil (error ()
+                                            (plug module scanner pset)
+                                            (skip-until (:keep-end nil)
+                                                        #\; #\}))))
+                                    (check-unused-properties pset))))
+                    (declare (ignore consumedp))
+                    (unless winp (syntax-error scanner result))))))))
+      (if stream (parse stream)
+         (with-open-file (stream pathname :direction :input)
+           (parse stream))))))
 
 (define-pluggable-parser module file (scanner pset)
   ;; `import' string `;'
                           (lambda (path true)
                             (handler-case
                                 (let ((module (read-module path
-                                                           :truename true)))
+                                                           :truename true
+                                                           :location
+                                                             (file-location
+                                                              scanner))))
                                   (when module
                                     (module-import module)
                                     (pushnew path (module-files *module*))
index ca0d511..64dab86 100644 (file)
 (export '(module module-name module-pset module-errors
          module-items module-files module-dependencies module-state))
 (defclass module ()
-  ((name :initarg :name :type pathname :reader module-name)
+  ((name :initarg :name :type (or pathname (eql :stdin)) :reader module-name)
    (%pset :initarg :pset :initform (make-pset)
          :type pset :reader module-pset)
    (errors :initarg :errors :initform 0 :type fixnum :reader module-errors)
index 3b4b263..a258699 100644 (file)
 
    TAG          The value to be returned if this option is encountered.  If
                this is a function, instead, the function is called with the
-               option's argument or nil.
+               option's argument or `nil'.
 
    NEGATED-TAG  As for TAG, but used if the negated form of the option is
-               found.  If this is nil (the default), the option cannot be
+               found.  If this is `nil' (the default), the option cannot be
                negated.
 
    SHORT-NAME   The option's short name.  This must be a single character, or
                nil if the option has no short name.
 
-   ARG-NAME     The name of the option's argument, a string.  If this is nil,
-               the option doesn't accept an argument.  The name is shown in
-               the help text.
+   ARG-NAME     The name of the option's argument, a string.  If this is
+               `nil', the option doesn't accept an argument.  The name is
+               shown in the help text.
 
    ARG-OPTIONAL-P
                If non-nil, the option's argument is optional.  This is
 
    DOCUMENTATION
                The help text for this option.  It is automatically line-
-               wrapped.  If nil, the option is omitted from the help
+               wrapped.  If `nil', the option is omitted from the help
                text.
 
    Usually, one won't use `make-option', but use the `option' macro instead."
 (define-access-wrapper opt-documentation opt-%documentation)
 
 (export '(option-parser option-parser-p make-option-parser
-         op-options op-non-option op-long-only-p op-numeric-p
-         op-negated-numeric-p op-negated-p))
+         op-options op-non-option op-long-only-p
+         op-numeric-p op-negated-numeric-p op-negated-p))
 (defstruct (option-parser
             (:conc-name op-)
             (:constructor make-option-parser
                 (&key ((:args argstmp) (cdr *command-line*))
                       (options *options*)
-                      (non-option :skip)
+                      (non-option (if (uiop:getenv "POSIXLY_CORRECT") :stop
+                                      :skip))
                       ((:numericp numeric-p))
                       negated-numeric-p
                       long-only-p
 
    NON-OPTION   Behaviour when encountering a non-option argument.  The
                default is :skip.  Allowable values are:
-                 :skip -- pretend that it appeared after the option
+                 `:skip' -- pretend that it appeared after the option
                    arguments; this is the default behaviour of GNU getopt
-                 :stop -- stop parsing options, leaving the remaining
+                 `:stop' -- stop parsing options, leaving the remaining
                    command line unparsed
-                 :return -- return :non-option and the argument word
+                 `:return' -- return :non-option and the argument word
 
    NUMERIC-P    Non-nil tag (as for options) if numeric options (e.g., -43)
-               are to be allowed.  The default is nil.  (Anomaly: the
-               keyword for this argument is :numericp.)
+               are to be allowed.  The default is `nil'.  (Anomaly: the
+               keyword for this argument is `:numericp'.)
 
    NEGATED-NUMERIC-P
                Non-nil tag (as for options) if numeric options (e.g., -43)
                can be negated.  This is not the same thing as a negative
                numeric option!
 
-   LONG-ONLY-P  A misnomer inherited from GNU getopt.  Whether to allow
+   LONG-ONLY-P  A misnomer inherited from GNU `getopt'.  Whether to allow
                long options to begin with a single dash.  Short options are
                still allowed, and may be cuddled as usual.  The default is
-               nil."
+               `nil'."
   (args nil :type list)
   (%options nil :type list)
   (non-option :skip :type (or function (member :skip :stop :return)))
    Probably not that useful."))
 
 (defun option-parse-error (msg &rest args)
-  "Signal an option-parse-error with the given message and arguments."
+  "Signal an `option-parse-error' with the given message and arguments."
   (error (make-condition 'option-parse-error
                         :format-control msg
                         :format-arguments args)))
    This is the main option-parsing function.  OP is an option-parser object,
    initialized appropriately.  Returns two values, OPT and ARG: OPT is the
    tag of the next option read, and ARG is the argument attached to it, or
-   nil if there was no argument.  If there are no more options, returns nil
-   twice.  Options whose TAG is a function aren't returned; instead, the tag
-   function is called, with the option argument (or nil) as the only
-   argument.  It is safe for tag functions to throw out of
+   `nil' if there was no argument.  If there are no more options, returns
+   `nil' twice.  Options whose TAG is a function aren't returned; instead,
+   the tag function is called, with the option argument (or `nil') as the
+   only argument.  It is safe for tag functions to throw out of
    `option-parse-next', if they desparately need to.  (This is the only way
    to actually get `option-parse-next' to return a function value, should
    that be what you want.  See `option-parse-return' for a way of doing
       (loop
        (with-simple-restart (skip-option "Skip this bogus option.")
          (cond
-           ;;
+
            ;; We're embroiled in short options: handle them.
            ((op-short-opt op)
             (if (>= (op-short-opt-index op) (length (op-short-opt op)))
                                              (subseq str i)
                                            (setf (op-short-opt op)
                                                  nil))))))))
-           ;;
+
            ;; End of the list.  Say we've finished.
            ((not (more-args-p))
             (finished))
-           ;;
+
            ;; Process the next option.
            (t
             (let ((arg (peek-arg)))
               (cond
-                ;;
+
                 ;; Non-option.  Decide what to do.
                 ((or (<= (length arg) 1)
                      (and (char/= (char arg 0) #\-)
                             (ret :non-option arg))
                    (t (eat-arg)
                       (funcall (op-non-option op) arg))))
-                ;;
+
                 ;; Double-hyphen.  Stop right now.
                 ((string= arg "--")
                  (eat-arg)
                  (finished))
-                ;;
+
                 ;; Numbers.  Check these before long options, since `--43'
                 ;; is not a long option.
                 ((and (op-numeric-p op)
                      (if (functionp how)
                          (funcall how num)
                          (ret (if negp :negated-numeric :numeric) num)))))
-                ;;
+
                 ;; Long option.  Find the matching option-spec and process
                 ;; it.
                 ((and (char= (char arg 0) #\-)
                       (char= (char arg 1) #\-))
                  (eat-arg)
                  (process-long-option arg 2 nil))
-                ;;
+
                 ;; Short options.  All that's left.
                 (t
                  (eat-arg)
 (defmacro option-parse-try (&body body)
   "Report errors encountered while parsing options, and try to continue.
 
-   Also establishes a restart `stop-parsing'.  Returns t if parsing completed
-   successfully, or nil if errors occurred."
+   Also establishes a restart `stop-parsing'.  Returns `t' if parsing
+   completed successfully, or `nil' if errors occurred."
   (with-gensyms (retcode)
     `(let ((,retcode t))
        (restart-case
 (defun parse-c-integer (string &key radix (start 0) end)
   "Parse (a substring of) STRING according to the standard C rules.
 
-   Well, almost: the 0 and 0x prefixes are accepted, but so too are
-   0o (Haskell) and 0b (original); also RADIX_DIGITS is accepted, for any
-   radix between 2 and 36.  Prefixes are only accepted if RADIX is nil.
-   Returns two values: the integer parsed (or nil if there wasn't enough for
-   a sensible parse), and the index following the characters of the integer."
+   Well, almost: the `0' and `0x' prefixes are accepted, but so too are
+   `0o' (Haskell) and `0b' (original); also `RADIX_DIGITS' is accepted, for
+   any radix between 2 and 36.  Prefixes are only accepted if RADIX is `nil'.
+   Returns two values: the integer parsed (or `nil' if there wasn't enough
+   for a sensible parse), and the index following the characters of the
+   integer."
   (unless end (setf end (length string)))
   (labels ((simple (i r goodp sgn)
             (multiple-value-bind
 
 (export 'clear)
 (defopthandler clear (var) (&optional (value nil))
-  "Sets VAR to VALUE; defaults to `'nil'."
+  "Sets VAR to VALUE; defaults to `nil'."
   (setf var value))
 
 (export 'inc)
 (defopthandler inc (var) (&optional max (step 1))
   "Increments VAR by STEP (defaults to 1).
 
-   If MAX is not nil then VAR will not be made larger than MAX.  No errors
+   If MAX is not `nil' then VAR will not be made larger than MAX.  No errors
    are signalled."
   (incf var step)
   (when (and max (>= var max))
 (defopthandler dec (var) (&optional min (step 1))
   "Decrements VAR by STEP (defaults to 1).
 
-   If MIN is not nil, then VAR will not be made smaller than MIN.  No errors
-   are signalled."
+   If MIN is not `nil', then VAR will not be made smaller than MIN.  No
+   errors are signalled."
   (decf var step)
   (when (and min (<= var min))
     (setf var min)))
   "Stores in VAR the Lisp object found by reading the ARG.
 
    Evaluation is forbidden while reading ARG.  If there is an error during
-   reading, an error of type option-parse-error is signalled."
+   reading, an error of type `option-parse-error' is signalled."
   (handler-case
       (let ((*read-eval* nil))
        (multiple-value-bind (x end) (read-from-string arg t)
   "Stores in VAR the integer read from the ARG.
 
    Integers are parsed according to C rules, which is normal in Unix; the
-   RADIX may be nil to allow radix prefixes, or an integer between 2 and 36.
-   An option-parse-error is signalled if the ARG is not a valid integer, or
-   if it is not between MIN and MAX (either of which may be nil if no lower
-   or upper bound is wanted)."
+   RADIX may be `nil' to allow radix prefixes, or an integer between 2 and
+   36.  An `option-parse-error' is signalled if the ARG is not a valid
+   integer, or if it is not between MIN and MAX (either of which may be `nil'
+   if no lower or upper bound is wanted)."
   (multiple-value-bind (v end) (parse-c-integer arg :radix radix)
     (unless (and v (>= end (length arg)))
       (option-parse-error "Bad integer `~A'" arg))
 (defopthandler keyword (var arg) (&optional (valid t))
   "Converts ARG into a keyword.
 
-   If VALID is t, then any ARG string is acceptable: the argument is
+   If VALID is `t', then any ARG string is acceptable: the argument is
    uppercased and interned in the keyword package.  If VALID is a list, then
    we ensure that ARG matches one of the elements of the list; unambigious
    abbreviations are allowed."
 (defmacro defoptmacro (name args &body body)
   "Defines an option macro NAME.
 
-   Option macros should produce a list of expressions producing one option
+   Option macros should produce a list of expressions producing one `option'
    structure each."
   (multiple-value-bind (docs decls body) (parse-body body)
     `(progn
     "Does the heavy lifting for parsing an option form.
 
    See the docstring for the `option' macro for details of the syntax."
-  (flet ((doc (form)
-          (cond ((stringp form) form)
-                ((null (cdr form)) (car form))
-                (t `(format nil ,@form))))
-        (docp (form)
-          (or (stringp form)
-              (and (consp form)
-                   (stringp (car form))))))
-    (cond ((stringp form)
-          `(%make-option :documentation ,form))
-         ((not (listp form))
-          (error "option form must be string or list"))
-         ((and (docp (car form)) (null (cdr form)))
-          `(%make-option :documentation ,(doc (car form))))
-         (t
-          (let (long-name short-name
-                arg-name arg-optional-p
-                tag negated-tag
-                doc)
-            (dolist (f form)
-              (cond ((and (or (not tag) (not negated-tag))
-                          (or (keywordp f)
-                              (and (consp f)
-                                   (member (car f) '(lambda function)))))
-                     (if tag
-                         (setf negated-tag f)
-                         (setf tag f)))
-                    ((and (not long-name)
-                          (or (rationalp f)
-                              (symbolp f)
-                              (stringp f)))
-                     (setf long-name (if (stringp f) f
-                                         (format nil "~(~A~)" f))))
-                    ((and (not short-name)
-                          (characterp f))
-                     (setf short-name f))
-                    ((and (not doc)
-                          (docp f))
-                     (setf doc (doc f)))
-                    ((and (consp f) (symbolp (car f)))
-                     (case (car f)
-                       (:short-name (setf short-name (cadr f)))
-                       (:long-name (setf long-name (cadr f)))
-                       (:tag (setf tag (cadr f)))
-                       (:negated-tag (setf negated-tag (cadr f)))
-                       (:arg (setf arg-name (cadr f)))
-                       (:opt-arg (setf arg-name (cadr f))
-                                 (setf arg-optional-p t))
-                       (:doc (setf doc (doc (cdr f))))
-                       (t (let ((handler (get (car f)
-                                              'opthandler-function)))
-                            (unless handler
-                              (error "No handler `~S' defined." (car f)))
-                            (let* ((var (cadr f))
-                                   (arg (gensym))
-                                   (thunk `#'(lambda (,arg)
-                                               (,handler (locf ,var)
-                                                         ,arg
-                                                         ,@(cddr f)))))
-                              (if tag
-                                  (setf negated-tag thunk)
-                                  (setf tag thunk)))))))
-                    (t
-                     (error "Unexpected thing ~S in option form." f))))
-            `(make-option ,long-name ,short-name ,arg-name
-                          ,@(and arg-optional-p `(:arg-optional-p t))
-                          ,@(and tag `(:tag ,tag))
-                          ,@(and negated-tag `(:negated-tag ,negated-tag))
-                          ,@(and doc `(:documentation ,doc)))))))))
+    (flet ((doc (form)
+            (cond ((stringp form) form)
+                  ((null (cdr form)) (car form))
+                  (t `(format nil ,@form))))
+          (docp (form)
+            (or (stringp form)
+                (and (consp form)
+                     (stringp (car form))))))
+      (cond ((stringp form)
+            `(%make-option :documentation ,form))
+           ((not (listp form))
+            (error "option form must be string or list"))
+           ((and (docp (car form)) (null (cdr form)))
+            `(%make-option :documentation ,(doc (car form))))
+           (t
+            (let (long-name short-name
+                            arg-name arg-optional-p
+                            tag negated-tag
+                            doc)
+              (dolist (f form)
+                (cond ((and (or (not tag) (not negated-tag))
+                            (or (keywordp f)
+                                (and (consp f)
+                                     (member (car f) '(lambda function)))))
+                       (if tag
+                           (setf negated-tag f)
+                           (setf tag f)))
+                      ((and (not long-name)
+                            (or (rationalp f)
+                                (symbolp f)
+                                (stringp f)))
+                       (setf long-name (if (stringp f) f
+                                           (format nil "~(~A~)" f))))
+                      ((and (not short-name)
+                            (characterp f))
+                       (setf short-name f))
+                      ((and (not doc)
+                            (docp f))
+                       (setf doc (doc f)))
+                      ((and (consp f) (symbolp (car f)))
+                       (case (car f)
+                         (:short-name (setf short-name (cadr f)))
+                         (:long-name (setf long-name (cadr f)))
+                         (:tag (setf tag (cadr f)))
+                         (:negated-tag (setf negated-tag (cadr f)))
+                         (:arg (setf arg-name (cadr f)))
+                         (:opt-arg (setf arg-name (cadr f))
+                                   (setf arg-optional-p t))
+                         (:doc (setf doc (doc (cdr f))))
+                         (t (let ((handler (get (car f)
+                                                'opthandler-function)))
+                              (unless handler
+                                (error "No handler `~S' defined." (car f)))
+                              (let* ((var (cadr f))
+                                     (arg (gensym))
+                                     (thunk `#'(lambda (,arg)
+                                                 (,handler (locf ,var)
+                                                           ,arg
+                                                           ,@(cddr f)))))
+                                (if tag
+                                    (setf negated-tag thunk)
+                                    (setf tag thunk)))))))
+                      (t
+                       (error "Unexpected thing ~S in option form." f))))
+              `(make-option ,long-name ,short-name ,arg-name
+                            ,@(and arg-optional-p `(:arg-optional-p t))
+                            ,@(and tag `(:tag ,tag))
+                            ,@(and negated-tag `(:negated-tag ,negated-tag))
+                            ,@(and doc `(:documentation ,doc)))))))))
 
 (export 'options)
 (defmacro options (&rest optlist)
-  "More convenient way of initializing options.  The OPTLIST is a list of
-   OPTFORMS.  Each OPTFORM is one of the following:
+  "A more convenient way of initializing options.
+
+   The OPTLIST is a list of OPTFORMS.  Each OPTFORM is one of the following:
 
    STRING      A banner to print.
 
   (defun print-text (string
                     &optional (stream *standard-output*)
                     &key (start 0) (end nil))
-    "Prints and line-breaks STRING to a pretty-printed STREAM.
+    "Print and line-break STRING to a pretty-printed STREAM.
 
    The string is broken at whitespace and newlines in the obvious way.
    Stuff between square brackets is not broken: this makes usage messages
 
    The usage list is constructed from a list OPTS of `option' values, and
    a list MANDATORY-ARGS of mandatory argument names; the latter defaults to
-   nil if omitted."
+   `nil' if omitted."
   (let (short-simple long-simple short-arg long-arg)
     (dolist (o opts)
       (cond ((not (and (opt-documentation o)
                       (usage nil usagep)
                       (full-usage nil fullp)
                       (options nil optsp))
-  "Sets up all the required things a program needs to have to parse options
-   and respond to them properly."
+  "Sets up all the required things a program needs to have to parse options.
+
+   This is a simple shorthand for setting `*program-name*', `*help*',
+   `*version*', `*options*', and `*usage*' from the corresponding arguments.
+   If an argument is not given then the corresponding variable is left alone.
+
+   The USAGE argument should be a list of mandatory argument names to pass to
+   `simple-usage'; FULL-USAGE should be a complete usage-token list.  An
+   error will be signalled if both USAGE and FULL-USAGE are provided."
   (when progp (setf *program-name* program-name))
   (when helpp (setf *help* help))
   (when versionp (setf *version* version))
index 5010ea3..9535178 100644 (file)
@@ -35,12 +35,21 @@ sod \- Sensible Object Design translator
 .\"--------------------------------------------------------------------------
 .SH SYNOPSIS
 .B sod
-.RB [ \-p ]
+.RB [ \-Mp ]
+.RB [ \-\-backtrace ]
 .RB [ \-\-builtins ]
-.RB [ \-d
-.IR dir ]
 .RB [ \-I
 .IR dir ]
+.RB [ \-d
+.IR dir ]
+.if !t \{\
+.  br
+       \c
+.\}
+.RB [ \-e
+.IR lisp ]
+.RB [ \-l
+.IR file ]
 .RB [ \-t
 .IR out-type ]
 .IR sources ...
@@ -94,11 +103,39 @@ Look for imported modules and extension files in directory
 This option may be repeated:
 directories are searched in the order they were named.
 .TP
+.B "\-M, \-\-track-dependencies"
+For each output
+.I file
+produced,
+write a Makefile fragment listing the files it depends on
+to
+.IB file -dep \fR.
+Does nothing if
+.B \-p
+is in force.
+.TP
 .BI "\-d, \-\-directory=" dir
 Write output files to directory
 .IR dir ,
 instead of the current directory.
 .TP
+.B "\-e, \-\-eval=" lisp
+Evaluate the Lisp forms in
+.IR lisp ,
+in order.
+Nothing is printed:
+if you want output, write Lisp to print it.
+Forms are evaluated in the
+.B SOD-USER
+package.
+.TP
+.B "\-l, \-\-load=" file
+Load and evaluate Lisp code from
+.IR file .
+The file is loaded into the
+.B SOD-USER
+package.
+.TP
 .B "\-p, \-\-stdout"
 Write output to standard output,
 instead of to files.