Commit | Line | Data |
---|---|---|
dea4d055 MW |
1 | ;;; -*-lisp-*- |
2 | ;;; | |
3 | ;;; Parser for C types | |
4 | ;;; | |
5 | ;;; (c) 2009 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 | ||
26 | (cl:in-package #:sod) | |
27 | ||
28 | ;;;-------------------------------------------------------------------------- | |
29 | ;;; Declaration specifiers. | |
bf090e02 MW |
30 | ;;; |
31 | ;;; This stuff is distressingly complicated. | |
32 | ;;; | |
33 | ;;; Parsing a (single) declaration specifier is quite easy, and a declaration | |
34 | ;;; is just a sequence of these things. Except that there are a stack of | |
35 | ;;; rules about which ones are allowed to go together, and the language | |
36 | ;;; doesn't require them to appear in any particular order. | |
37 | ;;; | |
38 | ;;; A collection of declaration specifiers is carried about in a purpose-made | |
39 | ;;; object with a number of handy operations defined on it, and then I build | |
40 | ;;; some parsers in terms of them. The basic strategy is to parse | |
41 | ;;; declaration specifiers while they're valid, and keep track of what we've | |
42 | ;;; read. When I've reached the end, we'll convert what we've got into a | |
43 | ;;; `canonical form', and then convert that into a C type object of the | |
44 | ;;; appropriate kind. The whole business is rather more complicated than it | |
45 | ;;; really ought to be. | |
46 | ||
47 | ;; Firstly, a table of interesting things about the various declaration | |
48 | ;; specifiers that I might encounter. I categorize declaration specifiers | |
49 | ;; into four kinds. | |
50 | ;; | |
51 | ;; * `Type specifiers' describe the actual type, whether that's integer, | |
52 | ;; character, floating point, or some tagged or user-named type. | |
53 | ;; | |
54 | ;; * `Size specifiers' distinguish different sizes of the same basic type. | |
55 | ;; This is how we tell the difference between `int' and `long'. | |
56 | ;; | |
57 | ;; * `Sign specifiers' distinguish different signednesses. This is how we | |
58 | ;; tell the difference between `int' and `unsigned'. | |
59 | ;; | |
60 | ;; * `Qualifiers' are our old friends `const', `restrict' and `volatile'. | |
61 | ;; | |
62 | ;; These groupings are for my benefit here, in determining whether a | |
63 | ;; particular declaration specifier is valid in the current context. I don't | |
64 | ;; accept `function specifiers' (of which the only current example is | |
65 | ;; `inline') since it's meaningless to me. | |
dea4d055 MW |
66 | |
67 | (defclass declspec () | |
bf090e02 MW |
68 | ;; This could have been done with DEFSTRUCT just as well, but a DEFCLASS |
69 | ;; can be tweaked interactively, which is a win at the moment. | |
dea4d055 MW |
70 | ((label :type keyword :initarg :label :reader ds-label) |
71 | (name :type string :initarg :name :reader ds-name) | |
bf090e02 MW |
72 | (kind :type (member type sign size qualifier) |
73 | :initarg :kind :reader ds-kind) | |
74 | (taggedp :type boolean :initarg :taggedp | |
75 | :initform nil :reader ds-taggedp)) | |
76 | (:documentation | |
77 | "Represents the important components of a declaration specifier. | |
78 | ||
79 | The only interesting instances of this class are in the table | |
80 | `*declspec-map*'.")) | |
dea4d055 MW |
81 | |
82 | (defmethod shared-initialize :after ((ds declspec) slot-names &key) | |
bf090e02 MW |
83 | "If no name is provided then derive one from the label. |
84 | ||
85 | Most declaration specifiers have simple names for which this works well." | |
dea4d055 MW |
86 | (default-slot (ds 'name slot-names) |
87 | (string-downcase (ds-label ds)))) | |
88 | ||
dea4d055 MW |
89 | (defparameter *declspec-map* |
90 | (let ((map (make-hash-table :test #'equal))) | |
91 | (dolist (item '((type :void :char :int :float :double) | |
bf090e02 MW |
92 | ((type :taggedp t) :enum :struct :union) |
93 | (size :short :long (:long-long :name "long long")) | |
dea4d055 | 94 | (sign :signed :unsigned) |
bf090e02 MW |
95 | (qualifier :const :restrict :volatile))) |
96 | (destructuring-bind (kind &key (taggedp nil)) | |
97 | (let ((spec (car item))) | |
98 | (if (consp spec) spec (list spec))) | |
dea4d055 | 99 | (dolist (spec (cdr item)) |
bf090e02 MW |
100 | (destructuring-bind (label |
101 | &key | |
102 | (name (string-downcase label)) | |
103 | (taggedp taggedp)) | |
104 | (if (consp spec) spec (list spec)) | |
dea4d055 | 105 | (let ((ds (make-instance 'declspec |
bf090e02 MW |
106 | :label label |
107 | :name name | |
108 | :kind kind | |
109 | :taggedp taggedp))) | |
dea4d055 MW |
110 | (setf (gethash name map) ds |
111 | (gethash label map) ds)))))) | |
bf090e02 | 112 | map) |
3109662a | 113 | "Maps symbolic labels and textual names to `declspec' instances.") |
bf090e02 MW |
114 | |
115 | ;; A collection of declaration specifiers, and how to merge them together. | |
116 | ||
117 | (defclass declspecs () | |
118 | ;; Despite the fact that it looks pretty trivial, this can't be done with | |
119 | ;; DEFCLASS for the simple reason that we add more methods to the accessor | |
120 | ;; functions later. | |
121 | ((type :initform nil :initarg :type :reader ds-type) | |
122 | (sign :initform nil :initarg :sign :reader ds-sign) | |
123 | (size :initform nil :initarg :size :reader ds-size) | |
124 | (qualifier :initform nil :initarg :qualifiers :reader ds-qualifiers)) | |
125 | (:documentation | |
126 | "Represents a collection of declaration specifiers. | |
127 | ||
128 | This is used during type parsing to represent the type under | |
129 | construction. Instances are immutable: we build new ones rather than | |
130 | modifying existing ones. This leads to a certain amount of churn, but | |
131 | we'll just have to live with that. | |
132 | ||
133 | (Why are instances immutable? Because it's much easier to merge a new | |
3109662a MW |
134 | specifier into an existing collection and then check that the resulting |
135 | thing is valid, rather than having to deal with all of the possible | |
bf090e02 MW |
136 | special cases of what the new thing might be. And if the merged |
137 | collection isn't good, I must roll back to the previous version. So I | |
138 | don't get to take advantage of a mutable structure.)")) | |
dea4d055 MW |
139 | |
140 | (defmethod ds-label ((ty c-type)) :c-type) | |
141 | (defmethod ds-name ((ty c-type)) (princ-to-string ty)) | |
142 | (defmethod ds-kind ((ty c-type)) 'type) | |
143 | ||
144 | (defparameter *good-declspecs* | |
145 | '(((:int) (:signed :unsigned) (:short :long :long-long)) | |
146 | ((:char) (:signed :unsigned) ()) | |
147 | ((:double) () (:long)) | |
148 | (t () ())) | |
149 | "List of good collections of declaration specifiers. | |
150 | ||
151 | Each item is a list of the form (TYPES SIGNS SIZES). Each of TYPES, SIGNS | |
152 | and SIZES is either a list of acceptable specifiers of the appropriate | |
153 | kind, or T, which matches any specifier.") | |
154 | ||
dea4d055 MW |
155 | (defun good-declspecs-p (specs) |
156 | "Are SPECS a good collection of declaration specifiers?" | |
157 | (let ((speclist (list (ds-type specs) (ds-sign specs) (ds-size specs)))) | |
158 | (some (lambda (it) | |
159 | (every (lambda (spec pat) | |
160 | (or (eq pat t) (null spec) | |
161 | (member (ds-label spec) pat))) | |
162 | speclist it)) | |
163 | *good-declspecs*))) | |
164 | ||
165 | (defun combine-declspec (specs ds) | |
166 | "Combine the declspec DS with the existing SPECS. | |
167 | ||
168 | Returns new DECLSPECS if they're OK, or `nil' if not. The old SPECS are | |
169 | not modified." | |
bf090e02 | 170 | |
dea4d055 MW |
171 | (let* ((kind (ds-kind ds)) |
172 | (old (slot-value specs kind))) | |
173 | (multiple-value-bind (ok new) | |
174 | (case kind | |
175 | (qualifier (values t (adjoin ds old))) | |
176 | (size (cond ((not old) (values t ds)) | |
177 | ((and (eq (ds-label old) :long) (eq ds old)) | |
178 | (values t (gethash :long-long *declspec-map*))) | |
179 | (t (values nil nil)))) | |
180 | (t (values (not old) ds))) | |
181 | (if ok | |
182 | (let ((copy (copy-instance specs))) | |
183 | (setf (slot-value copy kind) new) | |
184 | (and (good-declspecs-p copy) copy)) | |
185 | nil)))) | |
186 | ||
dea4d055 | 187 | (defun declspecs-type (specs) |
bf090e02 | 188 | "Convert `declspecs' SPECS into a standalone C type object." |
dea4d055 MW |
189 | (let ((type (ds-type specs)) |
190 | (size (ds-size specs)) | |
bf090e02 MW |
191 | (sign (ds-sign specs)) |
192 | (quals (mapcar #'ds-label (ds-qualifiers specs)))) | |
193 | (cond ((typep type 'c-type) | |
194 | (qualify-c-type type quals)) | |
195 | ((or type size sign) | |
196 | (when (and sign (eq (ds-label sign) :signed) | |
dea4d055 MW |
197 | (eq (ds-label type) :int)) |
198 | (setf sign nil)) | |
199 | (cond ((and (or (null type) (eq (ds-label type) :int)) | |
200 | (or size sign)) | |
201 | (setf type nil)) | |
202 | ((null type) | |
203 | (setf type (gethash :int *declspec-map*)))) | |
204 | (make-simple-type (format nil "~{~@[~A~^ ~]~}" | |
205 | (mapcar #'ds-label | |
206 | (remove nil | |
207 | (list sign size type)))) | |
bf090e02 | 208 | quals)) |
dea4d055 MW |
209 | (t |
210 | nil)))) | |
211 | ||
bf090e02 | 212 | ;; Parsing declaration specifiers. |
dea4d055 | 213 | |
bf090e02 | 214 | (define-indicator :declspec "<declaration-specifier>") |
dea4d055 | 215 | |
bf090e02 MW |
216 | (defun scan-declspec |
217 | (scanner &key (predicate (constantly t)) (indicator :declspec)) | |
3109662a | 218 | "Scan a `declspec' from SCANNER. |
dea4d055 | 219 | |
bf090e02 MW |
220 | If PREDICATE is provided then only succeed if (funcall PREDICATE DECLSPEC) |
221 | is true, where DECLSPEC is the raw declaration specifier or C-type object, | |
222 | so we won't have fetched the tag for a tagged type yet. If the PREDICATE | |
223 | returns false then the scan fails without consuming input. | |
dea4d055 | 224 | |
bf090e02 MW |
225 | If we couldn't find an acceptable declaration specifier then issue |
226 | INDICATOR as the failure indicator. Value on success is either a | |
227 | `declspec' object or a `c-type' object." | |
dea4d055 | 228 | |
bf090e02 MW |
229 | ;; Turns out to be easier to do this by hand. |
230 | (let ((ds (and (eq (token-type scanner) :id) | |
231 | (let ((kw (token-value scanner))) | |
232 | (or (gethash kw *module-type-map*) | |
233 | (gethash kw *declspec-map*)))))) | |
234 | (cond ((or (not ds) (and predicate (not (funcall predicate ds)))) | |
235 | (values (list indicator) nil nil)) | |
236 | ((ds-taggedp ds) | |
237 | (scanner-step scanner) | |
238 | (if (eq (token-type scanner) :id) | |
239 | (let ((ty (make-c-tagged-type (ds-label ds) | |
240 | (token-value scanner)))) | |
241 | (scanner-step scanner) | |
242 | (values ty t t)) | |
243 | (values :tag nil t))) | |
244 | (t | |
245 | (scanner-step scanner) | |
246 | (values ds t t))))) | |
dea4d055 | 247 | |
bf090e02 MW |
248 | (defun scan-and-merge-declspec (scanner specs) |
249 | "Scan a declaration specifier and merge it with SPECS. | |
250 | ||
251 | This is a parser function. If it succeeds, it returns the merged | |
252 | `declspecs' object. It can fail either if no valid declaration specifier | |
253 | is found or it cannot merge the declaration specifier with the existing | |
254 | SPECS." | |
255 | ||
256 | (with-parser-context (token-scanner-context :scanner scanner) | |
257 | (if-parse (:consumedp consumedp) (scan-declspec scanner) | |
258 | (aif (combine-declspec specs it) | |
259 | (values it t consumedp) | |
260 | (values (list :declspec) nil consumedp))))) | |
261 | ||
262 | (defun parse-c-type (scanner) | |
263 | "Parse a C type from declaration specifiers. | |
dea4d055 | 264 | |
bf090e02 MW |
265 | This is a parser function. If it succeeds then the result is a `c-type' |
266 | object representing the type it found. Note that this function won't try | |
267 | to parse a C declarator." | |
dea4d055 | 268 | |
bf090e02 MW |
269 | (with-parser-context (token-scanner-context :scanner scanner) |
270 | (if-parse (:result specs :consumedp cp) | |
271 | (many (specs (make-instance 'declspecs) it :min 1) | |
272 | (peek (scan-and-merge-declspec scanner specs))) | |
273 | (let ((type (declspecs-type specs))) | |
274 | (if type (values type t cp) | |
275 | (values (list :declspec) nil cp)))))) | |
dea4d055 | 276 | |
bf090e02 MW |
277 | ;;;-------------------------------------------------------------------------- |
278 | ;;; Parsing declarators. | |
279 | ;;; | |
280 | ;;; The syntax of declaration specifiers was horrific. Declarators are a | |
281 | ;;; very simple expression syntax, but this time the semantics are awful. In | |
282 | ;;; particular, they're inside-out. If <> denotes mumble of foo, then op <> | |
283 | ;;; is something like mumble of op of foo. Unfortunately, the expression | |
284 | ;;; parser engine wants to apply op of mumble of foo, so I'll have to do some | |
285 | ;;; work to fix the impedance mismatch. | |
286 | ;;; | |
287 | ;;; The currency we'll use is a pair (FUNC . NAME), with the semantics that | |
288 | ;;; (funcall FUNC TYPE) returns the derived type. The result of | |
289 | ;;; `parse-declarator' will be of this form. | |
dea4d055 | 290 | |
bf090e02 MW |
291 | (defun parse-declarator (scanner base-type &key abstractp) |
292 | (with-parser-context (token-scanner-context :scanner scanner) | |
dea4d055 | 293 | |
bf090e02 MW |
294 | (labels ((qualifiers () |
295 | ;; QUALIFIER* | |
296 | ||
297 | (parse | |
298 | (seq ((quals (list () | |
299 | (scan-declspec | |
300 | scanner | |
301 | :indicator :qualifier | |
302 | :predicate (lambda (ds) | |
303 | (and (typep ds 'declspec) | |
304 | (eq (ds-kind ds) | |
305 | 'qualifier))))))) | |
306 | (mapcar #'ds-label quals)))) | |
307 | ||
308 | (star () | |
309 | ;; Prefix: `*' QUALIFIERS | |
310 | ||
311 | (parse (seq (#\* (quals (qualifiers))) | |
312 | (preop "*" (state 9) | |
313 | (cons (lambda (type) | |
314 | (funcall (car state) | |
315 | (make-pointer-type type quals))) | |
316 | (cdr state)))))) | |
317 | ||
318 | (prefix-lparen () | |
319 | ;; Prefix: `(' | |
320 | ;; | |
321 | ;; Opening parentheses are treated as prefix operators by the | |
322 | ;; expression parsing engine. There's an annoying ambiguity | |
323 | ;; in the syntax if abstract declarators are permitted: a `(' | |
324 | ;; might be either the start of a nested subdeclarator or the | |
325 | ;; start of a postfix function argument list. The two are | |
326 | ;; disambiguated by stating that if the token following the | |
327 | ;; `(' is a `)' or a declaration specifier, then we have a | |
328 | ;; postfix argument list. | |
329 | ||
330 | (parse | |
331 | (peek (seq (#\( | |
332 | (nil (if (and abstractp | |
333 | (eq (token-type scanner) :id) | |
334 | (let ((id (token-value scanner))) | |
335 | (or (gethash id | |
336 | *module-type-map*) | |
337 | (gethash id | |
338 | *declspec-map*)))) | |
339 | (values nil nil nil) | |
340 | (values t t nil)))) | |
341 | (lparen #\)))))) | |
342 | ||
343 | (centre () | |
344 | ;; ID | empty | |
345 | ;; | |
346 | ;; The centre might be empty or contain an identifier, | |
347 | ;; depending on the setting of ABSTRACTP. | |
348 | ||
349 | (parse (or (when (not (eq abstractp t)) | |
350 | (seq ((id :id)) (cons #'identity id))) | |
351 | (when abstractp | |
352 | (t (cons #'identity nil)))))) | |
353 | ||
354 | (argument-list () | |
355 | ;; [ ARGUMENT [ `,' ARGUMENT ]* ] | |
356 | ||
357 | (parse (list () | |
358 | (seq ((base-type (parse-c-type scanner)) | |
359 | (dtor (parse-declarator scanner | |
360 | base-type | |
361 | :abstractp :maybe))) | |
362 | (make-argument (cdr dtor) (car dtor))) | |
363 | #\,))) | |
364 | ||
365 | (postfix-lparen () | |
366 | ;; Postfix: `(' ARGUMENT-LIST `)' | |
367 | ||
368 | (parse (seq (#\( (args (argument-list)) #\)) | |
369 | (postop "()" (state 9) | |
370 | (cons (lambda (type) | |
371 | (funcall (car state) | |
372 | (make-function-type type args))) | |
373 | (cdr state)))))) | |
374 | ||
375 | (dimension () | |
376 | ;; `[' C-FRAGMENT ']' | |
377 | ||
378 | (parse-delimited-fragment scanner #\[ #\])) | |
379 | ||
380 | (lbracket () | |
381 | ;; Postfix: DIMENSION+ | |
382 | ||
383 | (parse (seq ((dims (list (:min 1) (dimension)))) | |
384 | (postop "[]" (state 10) | |
385 | (cons (lambda (type) | |
386 | (funcall (car state) | |
387 | (make-array-type type dims))) | |
388 | (cdr state))))))) | |
389 | ||
390 | ;; And now we actually do the declarator parsing. | |
391 | (parse (seq ((value (expr (:nestedp nestedp) | |
392 | ||
393 | ;; An actual operand. | |
394 | (centre) | |
395 | ||
396 | ;; Binary operators. There aren't any. | |
397 | nil | |
398 | ||
399 | ;; Prefix operators. | |
400 | (or (star) | |
401 | (prefix-lparen)) | |
402 | ||
403 | ;; Postfix operators. | |
404 | (or (postfix-lparen) | |
405 | (lbracket) | |
406 | (when nestedp (seq (#\)) (rparen #\)))))))) | |
407 | (cons (funcall (car value) base-type) (cdr value))))))) | |
dea4d055 MW |
408 | |
409 | ;;;----- That's all, folks -------------------------------------------------- |