From 15ad30aaab6e48abcae0f1ecd1e2073cc1827b50 Mon Sep 17 00:00:00 2001 From: Mark Wooding Date: Fri, 13 Aug 2021 19:49:55 +0100 Subject: [PATCH] @@@ yet more mess --- .gitignore | 11 +- COPYING | 1 + COPYING.LIB | 1 + config/auto-version | 1 + config/confsubst | 1 + doc/Makefile.am | 2 +- doc/cmdline.tex | 164 ++++++++++++++++++++++++++ m4/mdw-auto-version.m4 | 1 + m4/mdw-libtool-version-info.m4 | 1 + m4/mdw-silent-rules.m4 | 1 + src/frontend.lisp | 8 +- src/module-output.lisp | 13 +-- src/module-parse.lisp | 48 ++++---- src/module-proto.lisp | 2 +- src/optparse.lisp | 254 +++++++++++++++++++++-------------------- src/sod.1.in | 43 ++++++- 16 files changed, 393 insertions(+), 159 deletions(-) create mode 120000 COPYING create mode 120000 COPYING.LIB create mode 120000 config/auto-version create mode 120000 config/confsubst create mode 100644 doc/cmdline.tex create mode 120000 m4/mdw-auto-version.m4 create mode 120000 m4/mdw-libtool-version-info.m4 create mode 120000 m4/mdw-silent-rules.m4 diff --git a/.gitignore b/.gitignore index 3c673e9..3bd07ad 100644 --- a/.gitignore +++ b/.gitignore @@ -12,9 +12,14 @@ *.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 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 index 0000000..8d44cb9 --- /dev/null +++ b/COPYING.LIB @@ -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 index 0000000..652e105 --- /dev/null +++ b/config/auto-version @@ -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 index 0000000..8e7de22 --- /dev/null +++ b/config/confsubst @@ -0,0 +1 @@ +../.ext/cfd/build/confsubst \ No newline at end of file diff --git a/doc/Makefile.am b/doc/Makefile.am index 89484a9..8bb0a8e 100644 --- a/doc/Makefile.am +++ b/doc/Makefile.am @@ -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 index 0000000..299ae9a --- /dev/null +++ b/doc/cmdline.tex @@ -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 @@] @[@-d @@] + @[@-e @@] @[@-l @@] + @[@-t @@] + @ \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=|@] Evaluate the Lisp form(s) in @, 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=|@] Load and evaluate Lisp code from @. + 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=|@] Look for imported modules in @. + 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=|@] Write output files to the directory + @, 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=|@] Produce output of 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 @ is + converted into a Lisp keyword @, by uppercasing it and interning it + in the @|keyword| package. Each requested module is loaded, and then, for + each requested @, 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 @ + will be @|@/@.c|, and the dependency file will be + @|@/@.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 @ will be + @|@/@.h|, and the dependency file will be + @|@/@.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 index 0000000..db358e4 --- /dev/null +++ b/m4/mdw-auto-version.m4 @@ -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 index 0000000..3298202 --- /dev/null +++ b/m4/mdw-libtool-version-info.m4 @@ -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 index 0000000..52d11e3 --- /dev/null +++ b/m4/mdw-silent-rules.m4 @@ -0,0 +1 @@ +../.ext/cfd/m4/mdw-silent-rules.m4 \ No newline at end of file diff --git a/src/frontend.lisp b/src/frontend.lisp index 6fb9d2e..a00a8bb 100644 --- a/src/frontend.lisp +++ b/src/frontend.lisp @@ -119,8 +119,12 @@ ("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") diff --git a/src/module-output.lisp b/src/module-output.lisp index d09dfd8..21fcadd 100644 --- a/src/module-output.lisp +++ b/src/module-output.lisp @@ -270,13 +270,12 @@ ;; 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 diff --git a/src/module-parse.lisp b/src/module-parse.lisp index eff4af7..43a49ad 100644 --- a/src/module-parse.lisp +++ b/src/module-parse.lisp @@ -100,7 +100,7 @@ ;;; 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 @@ -115,24 +115,29 @@ (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 `;' @@ -152,7 +157,10 @@ (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*)) diff --git a/src/module-proto.lisp b/src/module-proto.lisp index ca0d511..64dab86 100644 --- a/src/module-proto.lisp +++ b/src/module-proto.lisp @@ -151,7 +151,7 @@ (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) diff --git a/src/optparse.lisp b/src/optparse.lisp index 3b4b263..a258699 100644 --- a/src/optparse.lisp +++ b/src/optparse.lisp @@ -155,18 +155,18 @@ 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 @@ -174,7 +174,7 @@ 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." @@ -188,14 +188,15 @@ (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 @@ -214,25 +215,25 @@ 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))) @@ -255,7 +256,7 @@ 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))) @@ -279,10 +280,10 @@ 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 @@ -372,7 +373,7 @@ (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))) @@ -398,16 +399,16 @@ (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) #\-) @@ -420,12 +421,12 @@ (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) @@ -450,14 +451,14 @@ (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) @@ -476,8 +477,8 @@ (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 @@ -544,11 +545,12 @@ (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 @@ -612,14 +614,14 @@ (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)) @@ -629,8 +631,8 @@ (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))) @@ -640,7 +642,7 @@ "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) @@ -655,10 +657,10 @@ "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)) @@ -680,7 +682,7 @@ (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." @@ -733,7 +735,7 @@ (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 @@ -759,80 +761,81 @@ "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. @@ -897,7 +900,7 @@ (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 @@ -937,7 +940,7 @@ 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) @@ -1125,8 +1128,15 @@ (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)) diff --git a/src/sod.1.in b/src/sod.1.in index 5010ea3..9535178 100644 --- a/src/sod.1.in +++ b/src/sod.1.in @@ -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. -- 2.11.0