5 ;;; (c) 2009 Straylight/Edgeware
8 ;;;----- Licensing notice ---------------------------------------------------
10 ;;; This file is part of the Sensible 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.
28 ;;;--------------------------------------------------------------------------
29 ;;; Declaration specifiers.
31 ;;; This stuff is distressingly complicated.
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.
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.
47 ;; Firstly, a table of interesting things about the various declaration
48 ;; specifiers that I might encounter. I categorize declaration specifiers
51 ;; * `Type specifiers' describe the actual type, whether that's integer,
52 ;; character, floating point, or some tagged or user-named type.
54 ;; * `Size specifiers' distinguish different sizes of the same basic type.
55 ;; This is how we tell the difference between `int' and `long'.
57 ;; * `Sign specifiers' distinguish different signednesses. This is how we
58 ;; tell the difference between `int' and `unsigned'.
60 ;; * `Qualifiers' are our old friends `const', `restrict' and `volatile'.
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.
68 ;; Despite the fact that it looks pretty trivial, this can't be done with
69 ;; `defstruct' for the simple reason that we add more methods to the
70 ;; accessor functions later.
71 ((label :type keyword :initarg :label :reader ds-label)
72 (name :type string :initarg :name :reader ds-name)
73 (kind :type (member type sign size qualifier)
74 :initarg :kind :reader ds-kind)
75 (taggedp :type boolean :initarg :taggedp
76 :initform nil :reader ds-taggedp))
78 "Represents the important components of a declaration specifier.
80 The only interesting instances of this class are in the table
83 (defmethod shared-initialize :after ((ds declspec) slot-names &key)
84 "If no name is provided then derive one from the label.
86 Most declaration specifiers have simple names for which this works well."
87 (default-slot (ds 'name slot-names)
88 (string-downcase (ds-label ds))))
90 (defparameter *declspec-map*
91 (let ((map (make-hash-table :test #'equal)))
92 (dolist (item '((type :void :char :int :float :double
93 (:bool :name "_Bool"))
94 (complexity (:complex :name "_Complex")
95 (:imaginary :name "_Imaginary"))
96 ((type :taggedp t) :enum :struct :union)
97 (size :short :long (:long-long :name "long long"))
98 (sign :signed :unsigned)
99 (qualifier :const :restrict :volatile)))
100 (destructuring-bind (kind &key (taggedp nil))
101 (let ((spec (car item)))
102 (if (consp spec) spec (list spec)))
103 (dolist (spec (cdr item))
104 (destructuring-bind (label
106 (name (string-downcase label))
108 (if (consp spec) spec (list spec))
109 (let ((ds (make-instance 'declspec
114 (setf (gethash name map) ds
115 (gethash label map) ds))))))
116 (dolist (label '(:complex :imaginary :bool))
117 (setf (gethash (string-downcase label) map) (gethash label map)))
119 "Maps symbolic labels and textual names to `declspec' instances.")
121 ;; A collection of declaration specifiers, and how to merge them together.
123 (defclass declspecs ()
124 ;; This could have been done with `defstruct' just as well, but a
125 ;; `defclass' can be tweaked interactively, which is a win at the moment.
126 ((type :initform nil :initarg :type :reader ds-type)
127 (complexity :initform nil :initarg :complexity :reader ds-complexity)
128 (sign :initform nil :initarg :sign :reader ds-sign)
129 (size :initform nil :initarg :size :reader ds-size)
130 (qualifier :initform nil :initarg :qualifiers :reader ds-qualifiers))
132 "Represents a collection of declaration specifiers.
134 This is used during type parsing to represent the type under
135 construction. Instances are immutable: we build new ones rather than
136 modifying existing ones. This leads to a certain amount of churn, but
137 we'll just have to live with that.
139 (Why are instances immutable? Because it's much easier to merge a new
140 specifier into an existing collection and then check that the resulting
141 thing is valid, rather than having to deal with all of the possible
142 special cases of what the new thing might be. And if the merged
143 collection isn't good, I must roll back to the previous version. So I
144 don't get to take advantage of a mutable structure.)"))
146 (defmethod ds-label ((ty c-type)) :c-type)
147 (defmethod ds-name ((ty c-type)) (princ-to-string ty))
148 (defmethod ds-kind ((ty c-type)) 'type)
150 (defparameter *good-declspecs*
151 '(((:int) (:signed :unsigned) (:short :long :long-long) ())
152 ((:char) (:signed :unsigned) () ())
153 ((:double) () (:long) (:complex :imaginary))
155 "List of good collections of declaration specifiers.
157 Each item is a list of the form (TYPES SIGNS SIZES COMPLEXITIES). Each of
158 TYPES, SIGNS, SIZES, and COMPLEXITIES, is either a list of acceptable
159 specifiers of the appropriate kind, or T, which matches any specifier.")
161 (defun good-declspecs-p (specs)
162 "Are SPECS a good collection of declaration specifiers?"
163 (let ((speclist (list (ds-type specs)
166 (ds-complexity specs))))
168 (every (lambda (spec pat)
169 (or (eq pat t) (null spec)
170 (member (ds-label spec) pat)))
174 (defun combine-declspec (specs ds)
175 "Combine the declspec DS with the existing SPECS.
177 Returns new DECLSPECS if they're OK, or `nil' if not. The old SPECS are
180 (let* ((kind (ds-kind ds))
181 (old (slot-value specs kind)))
182 (multiple-value-bind (ok new)
184 (qualifier (values t (adjoin ds old)))
185 (size (cond ((not old) (values t ds))
186 ((and (eq (ds-label old) :long) (eq ds old))
187 (values t (gethash :long-long *declspec-map*)))
188 (t (values nil nil))))
189 (t (values (not old) ds)))
191 (let ((copy (copy-instance specs)))
192 (setf (slot-value copy kind) new)
193 (and (good-declspecs-p copy) copy))
196 (defun declspecs-type (specs)
197 "Convert `declspecs' SPECS into a standalone C type object."
198 (let ((type (ds-type specs))
199 (size (ds-size specs))
200 (sign (ds-sign specs))
201 (cplx (ds-complexity specs))
202 (quals (mapcar #'ds-label (ds-qualifiers specs))))
203 (cond ((typep type 'c-type)
204 (qualify-c-type type quals))
205 ((or type size sign cplx)
206 (when (and sign (eq (ds-label sign) :signed)
207 (eq (ds-label type) :int))
209 (cond ((and (or (null type) (eq (ds-label type) :int))
213 (setf type (gethash :int *declspec-map*))))
214 (make-simple-type (format nil "~{~@[~A~^ ~]~}"
223 ;; Parsing declaration specifiers.
225 (define-indicator :declspec "<declaration-specifier>")
228 (scanner &key (predicate (constantly t)) (indicator :declspec))
229 "Scan a `declspec' from SCANNER.
231 If PREDICATE is provided then only succeed if (funcall PREDICATE DECLSPEC)
232 is true, where DECLSPEC is the raw declaration specifier or C-type object,
233 so we won't have fetched the tag for a tagged type yet. If the PREDICATE
234 returns false then the scan fails without consuming input.
236 If we couldn't find an acceptable declaration specifier then issue
237 INDICATOR as the failure indicator. Value on success is either a
238 `declspec' object or a `c-type' object."
240 ;; Turns out to be easier to do this by hand.
241 (let ((ds (and (eq (token-type scanner) :id)
242 (let ((kw (token-value scanner)))
243 (or (gethash kw *module-type-map*)
244 (gethash kw *declspec-map*))))))
245 (cond ((or (not ds) (and predicate (not (funcall predicate ds))))
246 (values (list indicator) nil nil))
247 ((and (typep ds 'declspec) (ds-taggedp ds))
248 (scanner-step scanner)
249 (if (eq (token-type scanner) :id)
250 (let ((ty (make-c-tagged-type (ds-label ds)
251 (token-value scanner))))
252 (scanner-step scanner)
254 (values :tag nil t)))
256 (scanner-step scanner)
259 (defun scan-and-merge-declspec (scanner specs)
260 "Scan a declaration specifier and merge it with SPECS.
262 This is a parser function. If it succeeds, it returns the merged
263 `declspecs' object. It can fail either if no valid declaration specifier
264 is found or it cannot merge the declaration specifier with the existing
267 (with-parser-context (token-scanner-context :scanner scanner)
268 (if-parse (:consumedp consumedp) (scan-declspec scanner)
269 (aif (combine-declspec specs it)
270 (values it t consumedp)
271 (values (list :declspec) nil consumedp)))))
273 (export 'parse-c-type)
274 (defun parse-c-type (scanner)
275 "Parse a C type from declaration specifiers.
277 This is a parser function. If it succeeds then the result is a `c-type'
278 object representing the type it found. Note that this function won't try
279 to parse a C declarator."
281 (with-parser-context (token-scanner-context :scanner scanner)
282 (if-parse (:result specs :consumedp cp)
283 (many (specs (make-instance 'declspecs) it :min 1)
284 (peek (scan-and-merge-declspec scanner specs)))
285 (let ((type (declspecs-type specs)))
286 (if type (values type t cp)
287 (values (list :declspec) nil cp))))))
289 ;;;--------------------------------------------------------------------------
290 ;;; Parsing declarators.
292 ;;; The syntax of declaration specifiers was horrific. Declarators are a
293 ;;; very simple expression syntax, but this time the semantics are awful. In
294 ;;; particular, they're inside-out. If <> denotes mumble of foo, then op <>
295 ;;; is something like mumble of op of foo. Unfortunately, the expression
296 ;;; parser engine wants to apply op of mumble of foo, so I'll have to do some
297 ;;; work to fix the impedance mismatch.
299 ;;; The currency we'll use is a pair (FUNC . NAME), with the semantics that
300 ;;; (funcall FUNC TYPE) returns the derived type. The result of
301 ;;; `parse-declarator' will be of this form.
303 (export 'parse-declarator)
304 (defun parse-declarator (scanner base-type &key kernel abstractp)
305 "Parse a C declarator, returning a pair (C-TYPE . NAME).
307 The SCANNER is a token scanner to read from. The BASE-TYPE is the type
308 extracted from the preceding declaration specifiers, as parsed by
311 The result contains both the resulting constructed C-TYPE (with any
312 qualifiers etc. as necessary), and the name from the middle of the
313 declarator. The name is parsed using the KERNEL parser provided, and
314 defaults to matching a simple identifier `:id'. This might, e.g., be
315 (? :id) to parse an `abstract declarator' which has optional names.
317 There's an annoying ambiguity in the syntax, if an empty KERNEL is
318 permitted. In this case, you must ensure that ABSTRACTP is true so that
319 the appropriate heuristic can be applied. As a convenience, if ABSTRACTP
320 is true then `(? :id)' is used as the default KERNEL."
321 (with-parser-context (token-scanner-context :scanner scanner)
322 (let ((kernel-parser (cond (kernel kernel)
323 (abstractp (parser () (? :id)))
324 (t (parser () :id)))))
326 (labels ((qualifiers ()
330 (seq ((quals (list ()
333 :indicator :qualifier
334 :predicate (lambda (ds)
335 (and (typep ds 'declspec)
338 (mapcar #'ds-label quals))))
341 ;; Prefix: `*' qualifiers
343 (parse (seq (#\* (quals (qualifiers)))
347 (make-pointer-type type quals)))
350 (predict-argument-list-p ()
351 ;; See `prefix-lparen'. Predict an argument list rather
352 ;; than a nested declarator if (a) abstract declarators are
353 ;; permitted and (b) the next token is a declaration
354 ;; specifier or ellipsis.
355 (let ((type (token-type scanner))
356 (value (token-value scanner)))
358 (or (eq type :ellipsis)
360 (or (gethash value *module-type-map*)
361 (gethash value *declspec-map*)))))))
366 ;; Opening parentheses are treated as prefix operators by
367 ;; the expression parsing engine. There's an annoying
368 ;; ambiguity in the syntax if abstract declarators are
369 ;; permitted: a `(' might be either the start of a nested
370 ;; subdeclarator or the start of a postfix function argument
371 ;; list. The two are disambiguated by stating that if the
372 ;; token following the `(' is a `)' or a declaration
373 ;; specifier, then we have a postfix argument list.
376 (nil (if (predict-argument-list-p)
382 (parse (seq ((name (funcall kernel-parser)))
383 (cons #'identity name))))
386 ;; [argument [`,' argument]* [`,' `...']] | `...'
388 ;; The possibility of a trailing `,' `...' means that we
389 ;; can't use the standard `list' parser. Note that, unlike
390 ;; `real' C, we allow an ellipsis even if there are no
391 ;; explicit arguments.
395 (when (eq (token-type scanner) :ellipsis)
396 (push :ellipsis args)
397 (scanner-step scanner)
399 (multiple-value-bind (arg winp consumedp)
400 (parse (seq ((base-type (parse-c-type scanner))
401 (dtor (parse-declarator scanner
404 (make-argument (cdr dtor) (car dtor))))
406 (if (or consumedp args)
407 (return-from argument-list (values arg nil t))
410 (unless (eq (token-type scanner) #\,)
412 (scanner-step scanner))
413 (values (nreverse args) t args)))
416 ;; Postfix: `(' argument-list `)'
418 (parse (seq (#\( (args (argument-list)) #\))
419 (postop "()" (state 10)
422 (make-function-type type args)))
426 ;; `[' c-fragment ']'
428 (parse (seq ((frag (parse-delimited-fragment
430 (c-fragment-text frag))))
433 ;; Postfix: dimension+
435 (parse (seq ((dims (list (:min 1) (dimension))))
436 (postop "[]" (state 10)
439 (make-array-type type dims)))
442 ;; And now we actually do the declarator parsing.
443 (parse (seq ((value (expr (:nestedp nestedp)
445 ;; An actual operand.
448 ;; Binary operators. There aren't any.
455 ;; Postfix operators.
458 (when nestedp (seq (#\)) (rparen #\))))))))
459 (cons (funcall (car value) base-type) (cdr value))))))))
461 ;;;----- That's all, folks --------------------------------------------------