Commit | Line | Data |
---|---|---|
1d8cc67a MW |
1 | ;;; -*-lisp-*- |
2 | ;;; | |
3 | ;;; User interface | |
4 | ;;; | |
5 | ;;; (c) 2013 Straylight/Edgeware | |
6 | ;;; | |
7 | ||
8 | ;;;----- Licensing notice --------------------------------------------------- | |
9 | ;;; | |
10 | ;;; This file is part of the Sensble Object Design, an object system for C. | |
11 | ;;; | |
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. | |
16 | ;;; | |
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. | |
21 | ;;; | |
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. | |
25 | ||
7bfe3a37 MW |
26 | (cl:defpackage #:sod-frontend |
27 | (:use #:common-lisp #:optparse #:sod #:sod-parser) | |
28 | (:shadowing-import-from #:optparse "INT")) | |
29 | ||
30 | (cl:in-package #:sod-frontend) | |
1d8cc67a MW |
31 | |
32 | ;;;-------------------------------------------------------------------------- | |
33 | ;;; The main program. | |
34 | ||
9ec578d9 MW |
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." | |
39 | ||
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. | |
44 | ||
45 | (let ((path (ignore-errors (pathname arg)))) | |
46 | (cond ((null path) | |
47 | ;; The namestring couldn't be parsed, or something else went | |
48 | ;; horribly wrong. | |
49 | ||
50 | (option-parse-error "Can't parse `~A' as a path" arg)) | |
51 | ||
52 | #+unix | |
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. | |
56 | ||
57 | (setf var (make-pathname | |
58 | :name nil :type nil :defaults path | |
59 | :directory (append (or (pathname-directory path) | |
60 | (list :relative)) | |
61 | (list (file-namestring path)))))) | |
62 | ||
63 | (t | |
64 | ;; This actually looks like a plain directory name. | |
65 | ||
66 | (setf var path)))))) | |
67 | ||
1d8cc67a MW |
68 | (export 'main) |
69 | (defun main () | |
9ec578d9 MW |
70 | |
71 | ;; Initialize the argument parser. | |
1d8cc67a MW |
72 | (set-command-line-arguments) |
73 | ||
9ec578d9 MW |
74 | ;; Collect information from the command line options. |
75 | (let ((output-reasons nil) | |
76 | (output-path (make-pathname :directory '(:relative))) | |
77 | (builtinsp nil) | |
78 | (stdoutp nil) | |
79 | (args nil)) | |
80 | ||
81 | ;; Option definitions. | |
82 | (define-program | |
4aae7df0 | 83 | :help "Process SOD input files to produce (e.g.) C output." |
111dc923 | 84 | :version *sod-version* |
9ec578d9 MW |
85 | :usage "SOURCES..." |
86 | :options (options | |
87 | (help-options :short-version #\V) | |
88 | "Crazy options" | |
89 | (#\I "include" (:arg "DIR") | |
90 | ("Search DIR for module imports.") | |
91 | (list *module-dirs* 'string)) | |
92 | ("builtins" | |
93 | ("Process the builtin `sod-base' module.") | |
94 | (set builtinsp)) | |
95 | (#\d "directory" (:arg "DIR") | |
96 | ("Write output files to DIR.") | |
97 | (dirpath output-path)) | |
98 | (#\p "stdout" | |
99 | ("Write output files to standard output.") | |
100 | (set stdoutp)) | |
101 | (#\t "type" (:arg "OUT-TYPE") | |
102 | ("Produce output of type OUT-TYPE.") | |
103 | (list output-reasons 'keyword)))) | |
104 | ||
105 | ;; Actually parse the options. | |
106 | (unless (and (option-parse-try | |
107 | (do-options () | |
108 | (nil (rest) | |
109 | (setf args rest)))) | |
110 | (or builtinsp args)) | |
111 | (die-usage)) | |
112 | ||
113 | ;; Prepare the builtins. | |
114 | (make-builtin-module) | |
115 | ||
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*)) | |
120 | ||
121 | (flet ((hack-module (module) | |
122 | ;; Process the MODULE, writing out the generated code. | |
123 | ||
124 | ;; Work through each output type in turn. | |
125 | (dolist (reason output-reasons) | |
126 | ||
127 | ;; Arrange to be able to recover from errors. | |
128 | (restart-case | |
129 | ||
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))) | |
137 | ||
138 | (if stdoutp | |
139 | ||
140 | ;; If we're writing to stdout then just do | |
141 | ;; that. | |
142 | (output-module module reason | |
143 | *standard-output*) | |
144 | ||
145 | ;; Otherwise we have to construct an output | |
146 | ;; filename the hard way. | |
147 | (with-open-file | |
148 | (stream | |
149 | (reduce #'merge-pathnames | |
150 | (list output-path | |
151 | outpath | |
152 | (make-pathname | |
153 | :directory nil | |
154 | :defaults modpath)) | |
155 | :from-end t) | |
156 | :direction :output | |
157 | :if-exists :supersede | |
158 | :if-does-not-exist :create) | |
159 | (output-module module reason stream)))) | |
160 | ||
161 | ;; Error recovery. | |
162 | (continue () | |
163 | :report (lambda (stream) | |
164 | (format stream | |
165 | "Skip output type `~(~A~)'" | |
166 | reason)) | |
167 | nil))))) | |
168 | ||
169 | ;; If we're writing the builtin module then now seems like a | |
170 | ;; good time to do that. | |
171 | (when builtinsp | |
172 | (clear-the-decks) | |
173 | (hack-module *builtin-module*)) | |
174 | ||
175 | ;; Parse and write out the remaining modules. | |
176 | (dolist (arg args) | |
177 | (clear-the-decks) | |
178 | (hack-module (read-module arg)))))) | |
179 | ||
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)) | |
187 | ||
188 | ;; Exit with a sensible status. | |
189 | (exit (if (plusp nerror) 2 0))))) | |
1d8cc67a MW |
190 | |
191 | ;;;----- That's all, folks -------------------------------------------------- |