Commit | Line | Data |
---|---|---|
1d8cc67a MW |
1 | ;;; -*-lisp-*- |
2 | ;;; | |
3 | ;;; User interface | |
4 | ;;; | |
5 | ;;; (c) 2013 Straylight/Edgeware | |
6 | ;;; | |
7 | ||
8 | ;;;----- Licensing notice --------------------------------------------------- | |
9 | ;;; | |
e0808c47 | 10 | ;;; This file is part of the Sensible Object Design, an object system for C. |
1d8cc67a MW |
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 | ||
bb99b695 MW |
26 | (eval-when (:compile-toplevel :load-toplevel :execute) |
27 | (handler-bind ((warning #'muffle-warning)) | |
28 | (cl:defpackage #:sod-frontend | |
37fed326 | 29 | (:use #:common-lisp #:sod-utilities #:optparse #:sod #:sod-parser)))) |
7bfe3a37 MW |
30 | |
31 | (cl:in-package #:sod-frontend) | |
1d8cc67a MW |
32 | |
33 | ;;;-------------------------------------------------------------------------- | |
65d7091b MW |
34 | ;;; Preparation for dumping. |
35 | ||
54c01772 | 36 | (clear-the-decks) |
180bfa7c | 37 | (exercise) |
65d7091b MW |
38 | |
39 | ;;;-------------------------------------------------------------------------- | |
1d8cc67a MW |
40 | ;;; The main program. |
41 | ||
abbdf025 MW |
42 | (defvar-unbound *option-parser* |
43 | "The program's main option parser.") | |
44 | ||
9ec578d9 MW |
45 | (eval-when (:compile-toplevel :load-toplevel :execute) |
46 | (defopthandler dirpath (var arg) () | |
47 | "Convert the argument into a pathname with a directory component | |
48 | and no file component, suitable for merging." | |
49 | ||
50 | ;; This is really fiddly and annoying. Unix pathnames don't tell you | |
51 | ;; whether the thing named is meant to be a directory or not, and | |
52 | ;; implementations differ as to how they cope with pathnames which do or | |
53 | ;; don't name directories when they're expecting files, or vice versa. | |
54 | ||
55 | (let ((path (ignore-errors (pathname arg)))) | |
56 | (cond ((null path) | |
57 | ;; The namestring couldn't be parsed, or something else went | |
58 | ;; horribly wrong. | |
59 | ||
60 | (option-parse-error "Can't parse `~A' as a path" arg)) | |
61 | ||
62 | #+unix | |
63 | ((or (pathname-name path) (pathname-type path)) | |
64 | ;; If this is Unix, or similar, then stick the filename piece on | |
65 | ;; the end of the directory and hope that was sensible. | |
66 | ||
67 | (setf var (make-pathname | |
68 | :name nil :type nil :defaults path | |
69 | :directory (append (or (pathname-directory path) | |
70 | (list :relative)) | |
71 | (list (file-namestring path)))))) | |
72 | ||
73 | (t | |
74 | ;; This actually looks like a plain directory name. | |
75 | ||
76 | (setf var path)))))) | |
77 | ||
3a04cacb MW |
78 | (defun update-usage () |
79 | (setf *usage* (simple-usage *options* "SOURCES..."))) | |
80 | ||
d9bd7c90 MW |
81 | (export 'augment-options) |
82 | (defun augment-options (options) | |
83 | "Add OPTIONS to the program's options list." | |
84 | (asetf *options* (append it options)) | |
85 | (setf (op-options *option-parser*) *options*) | |
86 | (update-usage)) | |
87 | ||
88 | (use-package "SOD-FRONTEND" "SOD-USER") | |
89 | ||
1d8cc67a MW |
90 | (export 'main) |
91 | (defun main () | |
9ec578d9 MW |
92 | |
93 | ;; Initialize the argument parser. | |
1d8cc67a MW |
94 | (set-command-line-arguments) |
95 | ||
9ec578d9 MW |
96 | ;; Collect information from the command line options. |
97 | (let ((output-reasons nil) | |
98 | (output-path (make-pathname :directory '(:relative))) | |
ba8bae5f | 99 | (backtracep nil) |
9ec578d9 MW |
100 | (builtinsp nil) |
101 | (stdoutp nil) | |
e05aabbb | 102 | (track-deps-p nil) |
9ec578d9 MW |
103 | (args nil)) |
104 | ||
105 | ;; Option definitions. | |
106 | (define-program | |
4aae7df0 | 107 | :help "Process SOD input files to produce (e.g.) C output." |
111dc923 | 108 | :version *sod-version* |
9ec578d9 MW |
109 | :options (options |
110 | (help-options :short-version #\V) | |
05a2c613 | 111 | "Translator options" |
9ec578d9 MW |
112 | (#\I "include" (:arg "DIR") |
113 | ("Search DIR for module imports.") | |
114 | (list *module-dirs* 'string)) | |
ba8bae5f MW |
115 | ("backtrace" |
116 | ("Print a Lisp backtrace on error (for debugging).") | |
117 | (set backtracep)) | |
9ec578d9 MW |
118 | ("builtins" |
119 | ("Process the builtin `sod-base' module.") | |
120 | (set builtinsp)) | |
121 | (#\d "directory" (:arg "DIR") | |
122 | ("Write output files to DIR.") | |
123 | (dirpath output-path)) | |
d9bd7c90 MW |
124 | (#\e "eval" (:arg "LISP") |
125 | ("Evaluate raw Lisp code.") | |
126 | (lambda (lisp) | |
127 | (handler-case | |
128 | (let ((*package* (find-package "SOD-USER"))) | |
129 | (eval (read-from-string lisp))) | |
130 | (error (error) | |
131 | (option-parse-error "~A" error))))) | |
132 | (#\l "load" (:arg "FILE") | |
133 | ("Load a file of Lisp code.") | |
134 | (lambda (file) | |
135 | (let ((file (merge-pathnames file | |
136 | (make-pathname | |
137 | :type "LISP" | |
138 | :case :common)))) | |
139 | (handler-case | |
140 | (let ((*package* (find-package "SOD-USER"))) | |
141 | (find-file *default-pathname-defaults* file | |
142 | "Lisp file" | |
143 | (lambda (path true) | |
144 | (declare (ignore path)) | |
145 | (load true | |
146 | :verbose nil | |
147 | :print nil)))) | |
148 | (error (error) | |
149 | (option-parse-error "~A" error)))))) | |
e05aabbb MW |
150 | (#\M "track-dependencies" |
151 | "Write make(1) fragments recording dependencies." | |
152 | (set track-deps-p)) | |
9ec578d9 MW |
153 | (#\p "stdout" |
154 | ("Write output files to standard output.") | |
155 | (set stdoutp)) | |
156 | (#\t "type" (:arg "OUT-TYPE") | |
157 | ("Produce output of type OUT-TYPE.") | |
158 | (list output-reasons 'keyword)))) | |
3a04cacb | 159 | (update-usage) |
9ec578d9 MW |
160 | |
161 | ;; Actually parse the options. | |
abbdf025 MW |
162 | (let ((*option-parser* (make-option-parser))) |
163 | (unless (and (option-parse-try | |
164 | (do-options (:parser *option-parser*) | |
165 | (nil (rest) | |
166 | (setf args rest)))) | |
167 | (or builtinsp args)) | |
168 | (die-usage))) | |
9ec578d9 | 169 | |
9ec578d9 | 170 | ;; Do the main parsing job. |
ba8bae5f MW |
171 | (labels ((hack-module (module) |
172 | ;; Process the MODULE, writing out the generated code. | |
173 | ||
174 | ;; Work through each output type in turn. | |
175 | (dolist (reason output-reasons) | |
176 | ||
177 | ;; Arrange to be able to recover from errors. | |
178 | (restart-case | |
b0e21f83 MW |
179 | (cond |
180 | ||
181 | (stdoutp | |
182 | ;; If we're writing to stdout then use | |
183 | ;; `output-type-pathname' to check the output type | |
184 | ;; for us. | |
185 | ||
186 | (output-type-pathname reason) | |
187 | (output-module module reason *standard-output*)) | |
188 | ||
189 | (t | |
190 | ;; Otherwise we have to construct an output | |
191 | ;; filename the hard way. | |
192 | (with-open-file | |
193 | (stream | |
194 | (module-output-file module reason output-path) | |
195 | :direction :output | |
196 | :if-exists :supersede | |
197 | :if-does-not-exist :create) | |
e05aabbb MW |
198 | (output-module module reason stream)) |
199 | ||
200 | (when track-deps-p | |
201 | (write-dependency-file module reason | |
202 | output-path)))) | |
ba8bae5f MW |
203 | |
204 | ;; Error recovery. | |
205 | (continue () | |
206 | :report (lambda (stream) | |
207 | (format stream | |
208 | "Skip output type `~(~A~)'" | |
209 | reason)) | |
210 | nil)))) | |
211 | ||
212 | (hack-modules () | |
213 | ||
214 | ;; If there are no output types then there's nothing to do. | |
215 | (unless output-reasons | |
216 | (error "No output types given: nothing to do")) | |
217 | ||
218 | ;; If we're writing the builtin module then now seems like a | |
219 | ;; good time to do that. | |
220 | (when builtinsp | |
221 | (hack-module *builtin-module*)) | |
222 | ||
223 | ;; Parse and write out the remaining modules. | |
224 | (dolist (arg args) | |
287e744e MW |
225 | (let ((module (read-module arg))) |
226 | (when (zerop (module-errors module)) | |
227 | (hack-module module)))))) | |
ba8bae5f MW |
228 | |
229 | (if backtracep (hack-modules) | |
230 | (multiple-value-bind (hunoz nerror nwarn) | |
231 | (count-and-report-errors () | |
232 | (with-default-error-location | |
233 | ((make-file-location *program-name*)) | |
234 | (hack-modules))) | |
235 | (declare (ignore hunoz)) | |
236 | (when (or (plusp nerror) (plusp nwarn)) | |
237 | (format *error-output* "~A: Finished with~ | |
238 | ~[~:; ~:*~D error~:P~[~:; and~]~:*~]~ | |
239 | ~[~:; ~:*~D warning~:P~]~%" | |
240 | *program-name* nerror nwarn)) | |
241 | (exit (if (plusp nerror) 2 0))))))) | |
1d8cc67a MW |
242 | |
243 | ;;;----- That's all, folks -------------------------------------------------- |