chiark / gitweb /
@@@ 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 3c673e966c93a0b84aec41669c7e1a8d7e4ceae8..3bd07ad6200ae2f5984b443cb496669c17b78642 100644 (file)
 *.blg
 _region_.tex
 Makefile.in
 *.blg
 _region_.tex
 Makefile.in
-/COPYING
-/COPYING.LIB
 /aclocal.m4
 /autom4te.cache/
 /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
 /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 89484a9538436c632d20224d988cbe38f7820b6f..8bb0a8e58d4b4a357d18d822a2302457e8b1b7d9 100644 (file)
@@ -78,7 +78,7 @@ TEX_FILES             += tutorial.tex
 ## Reference.
 TEX_FILES              += refintro.tex
 TEX_FILES              += concepts.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
 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 6fb9d2e864639c7f79baca8a6fb2cfc8762f1c4f..a00a8bbbb35dc4c34e3a14561406a0f9acfe9a17 100644 (file)
@@ -119,8 +119,12 @@     (define-program
                     ("Evaluate raw Lisp code.")
                     (lambda (lisp)
                       (handler-case
                     ("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")
                         (error (error)
                           (option-parse-error "~A" error)))))
                (#\l "load" (:arg "FILE")
index d09dfd8b7f238b17ea88c53acbc69250bce5b608..21fcaddbd46d257cc04e2027fd5e803604388bf7 100644 (file)
@@ -270,13 +270,12 @@ (defmethod write-dependency-file ((module module) reason output-dir)
          ;; filetype case to do that.  Make a pathname and inspect it to
          ;; find out how to do this.
 
          ;; 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
 
         (outpath (output-type-pathname reason))
         (deppath (make-pathname :type (concatenate 'string
index eff4af7d40fbc2b344d8e509d2e629380af1805d..43a49ad177ea4cc0333ff6163952c29777363072 100644 (file)
@@ -100,7 +100,7 @@ (define-pluggable-parser module code (scanner pset)
 ;;; External files.
 
 (export 'read-module)
 ;;; 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
   "Parse the file at PATHNAME as a module, returning it.
 
    This is the main entry point for parsing module files.  You may well know
@@ -115,24 +115,29 @@ (defun read-module (pathname &key (truename nil truep) location)
                                  (make-pathname :type "SOD" :case :common)))
   (unless truep (setf truename (truename pathname)))
   (define-module (pathname :location location :truename truename)
                                  (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 `;'
 
 (define-pluggable-parser module file (scanner pset)
   ;; `import' string `;'
@@ -152,7 +157,10 @@ (define-pluggable-parser module file (scanner pset)
                           (lambda (path true)
                             (handler-case
                                 (let ((module (read-module path
                           (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*))
                                   (when module
                                     (module-import module)
                                     (pushnew path (module-files *module*))
index ca0d511dd2d77face5ebc28589d736306abfe980..64dab86547b27ba0583d4c44b3498d3f4a52d8bc 100644 (file)
@@ -151,7 +151,7 @@ (defgeneric finalize-module (module)
 (export '(module module-name module-pset module-errors
          module-items module-files module-dependencies module-state))
 (defclass module ()
 (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)
    (%pset :initarg :pset :initform (make-pset)
          :type pset :reader module-pset)
    (errors :initarg :errors :initform 0 :type fixnum :reader module-errors)
index 3b4b263debaf427b61dddb1428e88330ecb654df..a258699b9ace13b366b221907028a28133c3adcb 100644 (file)
@@ -155,18 +155,18 @@   (defstruct (option
 
    TAG          The value to be returned if this option is encountered.  If
                this is a function, instead, the function is called with the
 
    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
 
    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.
 
                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
 
    ARG-OPTIONAL-P
                If non-nil, the option's argument is optional.  This is
@@ -174,7 +174,7 @@   (defstruct (option
 
    DOCUMENTATION
                The help text for this option.  It is automatically line-
 
    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."
                text.
 
    Usually, one won't use `make-option', but use the `option' macro instead."
@@ -188,14 +188,15 @@   (defstruct (option
 (define-access-wrapper opt-documentation opt-%documentation)
 
 (export '(option-parser option-parser-p make-option-parser
 (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*)
 (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
                       ((:numericp numeric-p))
                       negated-numeric-p
                       long-only-p
@@ -214,25 +215,25 @@ (defstruct (option-parser
 
    NON-OPTION   Behaviour when encountering a non-option argument.  The
                default is :skip.  Allowable values are:
 
    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
                    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
                    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)
 
    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!
 
 
    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
                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)))
   (args nil :type list)
   (%options nil :type list)
   (non-option :skip :type (or function (member :skip :stop :return)))
@@ -255,7 +256,7 @@ (define-condition option-parse-error (error simple-condition)
    Probably not that useful."))
 
 (defun option-parse-error (msg &rest args)
    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)))
   (error (make-condition 'option-parse-error
                         :format-control msg
                         :format-arguments args)))
@@ -279,10 +280,10 @@ (defun option-parse-next (op)
    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
    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
    `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
@@ -372,7 +373,7 @@ (defun option-parse-next (op)
       (loop
        (with-simple-restart (skip-option "Skip this bogus option.")
          (cond
       (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)))
            ;; We're embroiled in short options: handle them.
            ((op-short-opt op)
             (if (>= (op-short-opt-index op) (length (op-short-opt op)))
@@ -398,16 +399,16 @@ (defun option-parse-next (op)
                                              (subseq str i)
                                            (setf (op-short-opt op)
                                                  nil))))))))
                                              (subseq str i)
                                            (setf (op-short-opt op)
                                                  nil))))))))
-           ;;
+
            ;; End of the list.  Say we've finished.
            ((not (more-args-p))
             (finished))
            ;; End of the list.  Say we've finished.
            ((not (more-args-p))
             (finished))
-           ;;
+
            ;; Process the next option.
            (t
             (let ((arg (peek-arg)))
               (cond
            ;; 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) #\-)
                 ;; Non-option.  Decide what to do.
                 ((or (<= (length arg) 1)
                      (and (char/= (char arg 0) #\-)
@@ -420,12 +421,12 @@ (defun option-parse-next (op)
                             (ret :non-option arg))
                    (t (eat-arg)
                       (funcall (op-non-option op) arg))))
                             (ret :non-option arg))
                    (t (eat-arg)
                       (funcall (op-non-option op) arg))))
-                ;;
+
                 ;; Double-hyphen.  Stop right now.
                 ((string= arg "--")
                  (eat-arg)
                  (finished))
                 ;; 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)
                 ;; Numbers.  Check these before long options, since `--43'
                 ;; is not a long option.
                 ((and (op-numeric-p op)
@@ -450,14 +451,14 @@ (defun option-parse-next (op)
                      (if (functionp how)
                          (funcall how num)
                          (ret (if negp :negated-numeric :numeric) num)))))
                      (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))
                 ;; 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)
                 ;; Short options.  All that's left.
                 (t
                  (eat-arg)
@@ -476,8 +477,8 @@ (export 'option-parse-try)
 (defmacro option-parse-try (&body body)
   "Report errors encountered while parsing options, and try to continue.
 
 (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
   (with-gensyms (retcode)
     `(let ((,retcode t))
        (restart-case
@@ -544,11 +545,12 @@ (defmethod (setf documentation)
 (defun parse-c-integer (string &key radix (start 0) end)
   "Parse (a substring of) STRING according to the standard C rules.
 
 (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
   (unless end (setf end (length string)))
   (labels ((simple (i r goodp sgn)
             (multiple-value-bind
@@ -612,14 +614,14 @@ (defopthandler set (var) (&optional (value t))
 
 (export 'clear)
 (defopthandler clear (var) (&optional (value nil))
 
 (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).
 
   (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))
    are signalled."
   (incf var step)
   (when (and max (>= var max))
@@ -629,8 +631,8 @@ (export 'dec)
 (defopthandler dec (var) (&optional min (step 1))
   "Decrements VAR by STEP (defaults to 1).
 
 (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)))
   (decf var step)
   (when (and min (<= var min))
     (setf var min)))
@@ -640,7 +642,7 @@ (defopthandler read (var arg) ()
   "Stores in VAR the Lisp object found by reading the ARG.
 
    Evaluation is forbidden while reading ARG.  If there is an error during
   "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)
   (handler-case
       (let ((*read-eval* nil))
        (multiple-value-bind (x end) (read-from-string arg t)
@@ -655,10 +657,10 @@ (defopthandler int (var arg) (&key radix min max)
   "Stores in VAR the integer read from the ARG.
 
    Integers are parsed according to C rules, which is normal in Unix; the
   "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))
   (multiple-value-bind (v end) (parse-c-integer arg :radix radix)
     (unless (and v (>= end (length arg)))
       (option-parse-error "Bad integer `~A'" arg))
@@ -680,7 +682,7 @@ (export 'keyword)
 (defopthandler keyword (var arg) (&optional (valid t))
   "Converts ARG into a keyword.
 
 (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."
    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."
@@ -733,7 +735,7 @@ (export 'defoptmacro)
 (defmacro defoptmacro (name args &body body)
   "Defines an option macro NAME.
 
 (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
    structure each."
   (multiple-value-bind (docs decls body) (parse-body body)
     `(progn
@@ -759,80 +761,81 @@   (defun parse-option-form (form)
     "Does the heavy lifting for parsing an option form.
 
    See the docstring for the `option' macro for details of the syntax."
     "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)
 
 (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.
 
 
    STRING      A banner to print.
 
@@ -897,7 +900,7 @@ (locally (declare #+sbcl (sb-ext:muffle-conditions style-warning))
   (defun print-text (string
                     &optional (stream *standard-output*)
                     &key (start 0) (end nil))
   (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 string is broken at whitespace and newlines in the obvious way.
    Stuff between square brackets is not broken: this makes usage messages
@@ -937,7 +940,7 @@ (defun simple-usage (opts &optional mandatory-args)
 
    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
 
    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)
   (let (short-simple long-simple short-arg long-arg)
     (dolist (o opts)
       (cond ((not (and (opt-documentation o)
@@ -1125,8 +1128,15 @@ (defun define-program (&key
                       (usage nil usagep)
                       (full-usage nil fullp)
                       (options nil optsp))
                       (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))
   (when progp (setf *program-name* program-name))
   (when helpp (setf *help* help))
   (when versionp (setf *version* version))
index 5010ea380eb7331d6833293281c6d8409139091d..9535178c15dcc9baad3f8ba9a77c7a2e91195d6d 100644 (file)
@@ -35,12 +35,21 @@ sod \- Sensible Object Design translator
 .\"--------------------------------------------------------------------------
 .SH SYNOPSIS
 .B sod
 .\"--------------------------------------------------------------------------
 .SH SYNOPSIS
 .B sod
-.RB [ \-p ]
+.RB [ \-Mp ]
+.RB [ \-\-backtrace ]
 .RB [ \-\-builtins ]
 .RB [ \-\-builtins ]
-.RB [ \-d
-.IR dir ]
 .RB [ \-I
 .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 ...
 .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
 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
 .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.
 .B "\-p, \-\-stdout"
 Write output to standard output,
 instead of to files.