5 ;;; (c) 2013 Straylight/Edgeware
8 ;;;----- Licensing notice ---------------------------------------------------
10 ;;; This file is part of the Sensble Object Design, an object system for C.
12 ;;; SOD is free software; you can redistribute it and/or modify
13 ;;; it under the terms of the GNU General Public License as published by
14 ;;; the Free Software Foundation; either version 2 of the License, or
15 ;;; (at your option) any later version.
17 ;;; SOD is distributed in the hope that it will be useful,
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;;; GNU General Public License for more details.
22 ;;; You should have received a copy of the GNU General Public License
23 ;;; along with SOD; if not, write to the Free Software Foundation,
24 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
26 (cl:defpackage #:sod-frontend
27 (:use #:common-lisp #:optparse #:sod #:sod-parser)
28 (:shadowing-import-from #:optparse "INT"))
30 (cl:in-package #:sod-frontend)
32 ;;;--------------------------------------------------------------------------
35 (eval-when (:compile-toplevel :load-toplevel :execute)
36 (defopthandler dirpath (var arg) ()
37 "Convert the argument into a pathname with a directory component
38 and no file component, suitable for merging."
40 ;; This is really fiddly and annoying. Unix pathnames don't tell you
41 ;; whether the thing named is meant to be a directory or not, and
42 ;; implementations differ as to how they cope with pathnames which do or
43 ;; don't name directories when they're expecting files, or vice versa.
45 (let ((path (ignore-errors (pathname arg))))
47 ;; The namestring couldn't be parsed, or something else went
50 (option-parse-error "Can't parse `~A' as a path" arg))
53 ((or (pathname-name path) (pathname-type path))
54 ;; If this is Unix, or similar, then stick the filename piece on
55 ;; the end of the directory and hope that was sensible.
57 (setf var (make-pathname
58 :name nil :type nil :defaults path
59 :directory (append (or (pathname-directory path)
61 (list (file-namestring path))))))
64 ;; This actually looks like a plain directory name.
71 ;; Initialize the argument parser.
72 (set-command-line-arguments)
74 ;; Collect information from the command line options.
75 (let ((output-reasons nil)
76 (output-path (make-pathname :directory '(:relative)))
81 ;; Option definitions.
83 :help "Process SOD input files to produce (e.g.) C output."
84 :version *sod-version*
87 (help-options :short-version #\V)
89 (#\I "include" (:arg "DIR")
90 ("Search DIR for module imports.")
91 (list *module-dirs* 'string))
93 ("Process the builtin `sod-base' module.")
95 (#\d "directory" (:arg "DIR")
96 ("Write output files to DIR.")
97 (dirpath output-path))
99 ("Write output files to standard output.")
101 (#\t "type" (:arg "OUT-TYPE")
102 ("Produce output of type OUT-TYPE.")
103 (list output-reasons 'keyword))))
105 ;; Actually parse the options.
106 (unless (and (option-parse-try
113 ;; Prepare the builtins.
114 (make-builtin-module)
116 ;; Do the main parsing job.
117 (multiple-value-bind (hunoz nerror nwarn)
118 (count-and-report-errors ()
119 (with-default-error-location ((make-file-location *program-name*))
121 (flet ((hack-module (module)
122 ;; Process the MODULE, writing out the generated code.
124 ;; Work through each output type in turn.
125 (dolist (reason output-reasons)
127 ;; Arrange to be able to recover from errors.
130 ;; Collect information for constructing the output
131 ;; filenames here. In particular,
132 ;; `output-type-pathname' will sanity-check the
133 ;; output type for us, which is useful even if
134 ;; we're writing to stdout.
135 (let ((outpath (output-type-pathname reason))
136 (modpath (module-name module)))
140 ;; If we're writing to stdout then just do
142 (output-module module reason
145 ;; Otherwise we have to construct an output
146 ;; filename the hard way.
149 (reduce #'merge-pathnames
157 :if-exists :supersede
158 :if-does-not-exist :create)
159 (output-module module reason stream))))
163 :report (lambda (stream)
165 "Skip output type `~(~A~)'"
169 ;; If we're writing the builtin module then now seems like a
170 ;; good time to do that.
173 (hack-module *builtin-module*))
175 ;; Parse and write out the remaining modules.
178 (hack-module (read-module arg))))))
180 ;; Report on how well everything worked.
181 (declare (ignore hunoz))
182 (when (or (plusp nerror) (plusp nwarn))
183 (format *error-output* "~A: Finished with~
184 ~[~:; ~:*~D error~:P~[~:; and~]~:*~]~
185 ~[~:; ~:*~D warning~:P~]~%"
186 *program-name* nerror nwarn))
188 ;; Exit with a sensible status.
189 (exit (if (plusp nerror) 2 0)))))
191 ;;;----- That's all, folks --------------------------------------------------