| 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 Sensible 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. |
| 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. |
| 66 | |
| 67 | (defclass declspec () |
| 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 complexity sign size qualifier specs) |
| 74 | :initarg :kind :reader ds-kind) |
| 75 | (taggedp :type boolean :initarg :taggedp |
| 76 | :initform nil :reader ds-taggedp)) |
| 77 | (:documentation |
| 78 | "Represents the important components of a declaration specifier. |
| 79 | |
| 80 | The only interesting instances of this class are in the table |
| 81 | `*declspec-map*'.")) |
| 82 | |
| 83 | (defmethod shared-initialize :after ((ds declspec) slot-names &key) |
| 84 | "If no name is provided then derive one from the label. |
| 85 | |
| 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)))) |
| 89 | |
| 90 | (defparameter *declspec-map* |
| 91 | (let ((map (make-hash-table :test #'equal))) |
| 92 | (dolist (item '((type :char :int :float :double) |
| 93 | (complexity (:complex :compat "_Complex") |
| 94 | (:imaginary :compat "_Imaginary")) |
| 95 | ((type :taggedp t) :enum :struct :union) |
| 96 | (size :short :long (:long-long :name "long long")) |
| 97 | (sign :signed :unsigned) |
| 98 | (qualifier :const :restrict :volatile |
| 99 | (:atomic :compat "_Atomic")))) |
| 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 |
| 105 | &key |
| 106 | (name (string-downcase label)) |
| 107 | compat |
| 108 | (taggedp taggedp)) |
| 109 | (if (consp spec) spec (list spec)) |
| 110 | (let ((ds (make-instance 'declspec |
| 111 | :label label |
| 112 | :name (or compat name) |
| 113 | :kind kind |
| 114 | :taggedp taggedp))) |
| 115 | (setf (gethash name map) ds |
| 116 | (gethash label map) ds) |
| 117 | (when compat |
| 118 | (setf (gethash compat map) ds))))))) |
| 119 | map) |
| 120 | "Maps symbolic labels and textual names to `declspec' instances.") |
| 121 | |
| 122 | (defclass storespec () |
| 123 | ((spec :initarg :spec :reader ds-spec)) |
| 124 | (:documentation "Carrier for a storage specifier.")) |
| 125 | |
| 126 | (defmethod ds-label ((spec storespec)) spec) |
| 127 | (defmethod ds-kind ((spec storespec)) 'specs) |
| 128 | |
| 129 | (defmethod ds-label ((ty c-type)) :c-type) |
| 130 | (defmethod ds-name ((ty c-type)) (princ-to-string ty)) |
| 131 | (defmethod ds-kind ((ty c-type)) 'type) |
| 132 | |
| 133 | ;; A collection of declaration specifiers, and how to merge them together. |
| 134 | |
| 135 | (defclass declspecs () |
| 136 | ;; This could have been done with `defstruct' just as well, but a |
| 137 | ;; `defclass' can be tweaked interactively, which is a win at the moment. |
| 138 | ((type :initform nil :initarg :type :reader ds-type) |
| 139 | (complexity :initform nil :initarg :complexity :reader ds-complexity) |
| 140 | (sign :initform nil :initarg :sign :reader ds-sign) |
| 141 | (size :initform nil :initarg :size :reader ds-size) |
| 142 | (specs :initform nil :initarg :specs :reader ds-specs) |
| 143 | (qualifier :initform nil :initarg :qualifiers :reader ds-qualifiers)) |
| 144 | (:documentation "Represents a collection of declaration specifiers. |
| 145 | |
| 146 | This is used during type parsing to represent the type under construction. |
| 147 | Instances are immutable: we build new ones rather than modifying existing |
| 148 | ones. This leads to a certain amount of churn, but we'll just have to |
| 149 | live with that. |
| 150 | |
| 151 | (Why are instances immutable? Because it's much easier to merge a new |
| 152 | specifier into an existing collection and then check that the resulting |
| 153 | thing is valid, rather than having to deal with all of the possible |
| 154 | special cases of what the new thing might be. And if the merged |
| 155 | collection isn't good, I must roll back to the previous version. So I |
| 156 | don't get to take advantage of a mutable structure.)")) |
| 157 | |
| 158 | (defparameter *good-declspecs* |
| 159 | '(((:int) (:signed :unsigned) (:short :long :long-long) ()) |
| 160 | ((:char) (:signed :unsigned) () ()) |
| 161 | ((:double) () (:long) (:complex :imaginary)) |
| 162 | (t () () ())) |
| 163 | "List of good collections of declaration specifiers. |
| 164 | |
| 165 | Each item is a list of the form (TYPES SIGNS SIZES COMPLEXITIES). Each of |
| 166 | TYPES, SIGNS, SIZES, and COMPLEXITIES, is either a list of acceptable |
| 167 | specifiers of the appropriate kind, or T, which matches any specifier.") |
| 168 | |
| 169 | (defun good-declspecs-p (specs) |
| 170 | "Are SPECS a good collection of declaration specifiers?" |
| 171 | (let ((speclist (list (ds-type specs) |
| 172 | (ds-sign specs) |
| 173 | (ds-size specs) |
| 174 | (ds-complexity specs)))) |
| 175 | (some (lambda (it) |
| 176 | (every (lambda (spec pat) |
| 177 | (or (eq pat t) (null spec) |
| 178 | (member (ds-label spec) pat))) |
| 179 | speclist it)) |
| 180 | *good-declspecs*))) |
| 181 | |
| 182 | (defun combine-declspec (specs ds) |
| 183 | "Combine the declspec DS with the existing SPECS. |
| 184 | |
| 185 | Returns new DECLSPECS if they're OK, or `nil' if not. The old SPECS are |
| 186 | not modified." |
| 187 | |
| 188 | (let* ((kind (ds-kind ds)) |
| 189 | (old (slot-value specs kind))) |
| 190 | (multiple-value-bind (ok new) |
| 191 | (case kind |
| 192 | (qualifier (values t (adjoin ds old))) |
| 193 | (size (cond ((not old) (values t ds)) |
| 194 | ((and (eq (ds-label old) :long) (eq ds old)) |
| 195 | (values t (gethash :long-long *declspec-map*))) |
| 196 | (t (values nil nil)))) |
| 197 | (specs (values t (adjoin (ds-spec ds) old))) |
| 198 | (t (values (not old) ds))) |
| 199 | (if ok |
| 200 | (let ((copy (copy-instance specs))) |
| 201 | (setf (slot-value copy kind) new) |
| 202 | (and (good-declspecs-p copy) copy)) |
| 203 | nil)))) |
| 204 | |
| 205 | (defun declspecs-type (specs) |
| 206 | "Convert `declspecs' SPECS into a standalone C type object." |
| 207 | (let* ((base-type (ds-type specs)) |
| 208 | (size (ds-size specs)) |
| 209 | (sign (ds-sign specs)) |
| 210 | (cplx (ds-complexity specs)) |
| 211 | (quals (mapcar #'ds-label (ds-qualifiers specs))) |
| 212 | (specs (ds-specs specs)) |
| 213 | (type (cond ((typep base-type 'c-type) |
| 214 | (qualify-c-type base-type quals)) |
| 215 | ((or base-type size sign cplx) |
| 216 | (when (and sign (eq (ds-label sign) :signed) |
| 217 | (eq (ds-label base-type) :int)) |
| 218 | (setf sign nil)) |
| 219 | (cond ((and (or (null base-type) |
| 220 | (eq (ds-label base-type) :int)) |
| 221 | (or size sign)) |
| 222 | (setf base-type nil)) |
| 223 | ((null base-type) |
| 224 | (setf base-type (gethash :int *declspec-map*)))) |
| 225 | (let* ((things (list sign cplx size base-type)) |
| 226 | (stripped (remove nil things)) |
| 227 | (names (mapcar #'ds-name stripped))) |
| 228 | (make-simple-type (format nil "~{~A~^ ~}" names) |
| 229 | quals))) |
| 230 | (t |
| 231 | nil)))) |
| 232 | (cond ((null type) nil) |
| 233 | ((null specs) type) |
| 234 | (t (make-storage-specifiers-type type specs))))) |
| 235 | |
| 236 | ;; Parsing declaration specifiers. |
| 237 | |
| 238 | (define-indicator :declspec "<declaration-specifier>") |
| 239 | |
| 240 | (defun scan-simple-declspec |
| 241 | (scanner &key (predicate (constantly t)) (indicator :declspec)) |
| 242 | "Scan a simple `declspec' from SCANNER. |
| 243 | |
| 244 | Simple declspecs are the ones defined in the `*declspec-map*' or |
| 245 | `*module-type-map*'. This covers the remaining possibilities if the |
| 246 | `complex-declspec' pluggable parser didn't find anything to match. |
| 247 | |
| 248 | If PREDICATE is provided then only succeed if (funcall PREDICATE DECLSPEC) |
| 249 | is true, where DECLSPEC is the raw declaration specifier or C-type object, |
| 250 | so we won't have fetched the tag for a tagged type yet. If the PREDICATE |
| 251 | returns false then the scan fails without consuming input. |
| 252 | |
| 253 | If we couldn't find an acceptable declaration specifier then issue |
| 254 | INDICATOR as the failure indicator. Value on success is either a |
| 255 | `declspec' object or a `c-type' object." |
| 256 | |
| 257 | ;; Turns out to be easier to do this by hand. |
| 258 | (let ((ds (and (eq (token-type scanner) :id) |
| 259 | (let ((kw (token-value scanner))) |
| 260 | (or (gethash kw *declspec-map*) |
| 261 | (and (boundp '*module-type-map*) |
| 262 | (gethash kw *module-type-map*)) |
| 263 | (find-simple-c-type kw)))))) |
| 264 | (cond ((or (not ds) (and predicate (not (funcall predicate ds)))) |
| 265 | (values (list indicator) nil nil)) |
| 266 | ((and (typep ds 'declspec) (ds-taggedp ds)) |
| 267 | (scanner-step scanner) |
| 268 | (if (eq (token-type scanner) :id) |
| 269 | (let ((ty (make-c-tagged-type (ds-label ds) |
| 270 | (token-value scanner)))) |
| 271 | (scanner-step scanner) |
| 272 | (values ty t t)) |
| 273 | (values :tag nil t))) |
| 274 | (t |
| 275 | (scanner-step scanner) |
| 276 | (values ds t t))))) |
| 277 | |
| 278 | (define-pluggable-parser complex-declspec atomic-typepsec (scanner) |
| 279 | ;; `atomic' `(' type-name `)' |
| 280 | ;; `_Atomic' `(' type-name `)' |
| 281 | (with-parser-context (token-scanner-context :scanner scanner) |
| 282 | (parse (peek (seq ((nil (or "atomic" "_Atomic")) |
| 283 | #\( |
| 284 | (decls (parse-c-type scanner)) |
| 285 | (subtype (parse-declarator scanner decls |
| 286 | :kernel (parse-empty) |
| 287 | :abstractp t)) |
| 288 | #\)) |
| 289 | (make-atomic-type (car subtype))))))) |
| 290 | |
| 291 | (define-pluggable-parser complex-declspec alignas (scanner) |
| 292 | ;; `alignas' `(' fragment `)' |
| 293 | ;; `_Alignas' `(' fragment `)' |
| 294 | (with-parser-context (token-scanner-context :scanner scanner) |
| 295 | (parse (peek (seq ((nil (or "alignas" "_Alignas")) |
| 296 | (nil (lisp (values #\( |
| 297 | (eq (token-type scanner) #\() |
| 298 | nil))) |
| 299 | (nil (commit)) |
| 300 | (frag (parse-delimited-fragment scanner #\( #\)))) |
| 301 | (make-instance 'storespec |
| 302 | :spec (make-instance |
| 303 | 'alignas-storage-specifier |
| 304 | :alignment frag))))))) |
| 305 | |
| 306 | (defun scan-and-merge-declspec (scanner specs) |
| 307 | "Scan a declaration specifier and merge it with SPECS. |
| 308 | |
| 309 | This is a parser function. If it succeeds, it returns the merged |
| 310 | `declspecs' object. It can fail either if no valid declaration specifier |
| 311 | is found or it cannot merge the declaration specifier with the existing |
| 312 | SPECS." |
| 313 | |
| 314 | (with-parser-context (token-scanner-context :scanner scanner) |
| 315 | (if-parse (:consumedp consumedp) |
| 316 | (or (plug complex-declspec scanner) |
| 317 | (scan-simple-declspec scanner)) |
| 318 | (aif (combine-declspec specs it) |
| 319 | (values it t consumedp) |
| 320 | (values (list :declspec) nil consumedp))))) |
| 321 | |
| 322 | (export 'parse-c-type) |
| 323 | (defun parse-c-type (scanner) |
| 324 | "Parse a C type from declaration specifiers. |
| 325 | |
| 326 | This is a parser function. If it succeeds then the result is a `c-type' |
| 327 | object representing the type it found. Note that this function won't try |
| 328 | to parse a C declarator." |
| 329 | |
| 330 | (with-parser-context (token-scanner-context :scanner scanner) |
| 331 | (if-parse (:result specs :consumedp cp) |
| 332 | (many (specs (make-instance 'declspecs) it :min 1) |
| 333 | (peek (scan-and-merge-declspec scanner specs))) |
| 334 | (let ((type (declspecs-type specs))) |
| 335 | (if type (values type t cp) |
| 336 | (values (list :declspec) nil cp)))))) |
| 337 | |
| 338 | ;;;-------------------------------------------------------------------------- |
| 339 | ;;; Parsing declarators. |
| 340 | ;;; |
| 341 | ;;; The syntax of declaration specifiers was horrific. Declarators are a |
| 342 | ;;; very simple expression syntax, but this time the semantics are awful. In |
| 343 | ;;; particular, they're inside-out. If <> denotes mumble of foo, then op <> |
| 344 | ;;; is something like mumble of op of foo. Unfortunately, the expression |
| 345 | ;;; parser engine wants to apply op of mumble of foo, so I'll have to do some |
| 346 | ;;; work to fix the impedance mismatch. |
| 347 | ;;; |
| 348 | ;;; The currency we'll use is a pair (FUNC . NAME), with the semantics that |
| 349 | ;;; (funcall FUNC TYPE) returns the derived type. The result of |
| 350 | ;;; `parse-declarator' will be of this form. |
| 351 | |
| 352 | (export 'parse-declarator) |
| 353 | (defun parse-declarator (scanner base-type &key kernel abstractp keywordp) |
| 354 | "Parse a C declarator, returning a pair (C-TYPE . NAME). |
| 355 | |
| 356 | The SCANNER is a token scanner to read from. The BASE-TYPE is the type |
| 357 | extracted from the preceding declaration specifiers, as parsed by |
| 358 | `parse-c-type'. |
| 359 | |
| 360 | The result contains both the resulting constructed C-TYPE (with any |
| 361 | qualifiers etc. as necessary), and the name from the middle of the |
| 362 | declarator. The name is parsed using the KERNEL parser provided, and |
| 363 | defaults to matching a simple identifier `:id'. This might, e.g., be |
| 364 | (? :id) to parse an `abstract declarator' which has optional names. |
| 365 | |
| 366 | If KEYWORDP is true, then a keyword argument list is permitted in |
| 367 | function declarations. |
| 368 | |
| 369 | There's an annoying ambiguity in the syntax, if an empty KERNEL is |
| 370 | permitted. In this case, you must ensure that ABSTRACTP is true so that |
| 371 | the appropriate heuristic can be applied. As a convenience, if ABSTRACTP |
| 372 | is true then `(? :id)' is used as the default KERNEL." |
| 373 | |
| 374 | ;; This is a bit confusing. This is a strangely-shaped operator grammer, |
| 375 | ;; which wouldn't be so bad, but the `values' being operated on are pairs |
| 376 | ;; of the form (FUNC . NAME). The NAME is whatever the KERNEL parser |
| 377 | ;; produces as its result, and will be passed out unchanged. The FUNC is a |
| 378 | ;; type-constructor function which will be eventually be applied to the |
| 379 | ;; input BASE-TYPE, but we can't calculate the actual result as we go along |
| 380 | ;; because of the rather annoying inside-out nature of the declarator |
| 381 | ;; syntax. |
| 382 | |
| 383 | (with-parser-context (token-scanner-context :scanner scanner) |
| 384 | (let ((kernel-parser (cond (kernel kernel) |
| 385 | (abstractp (parser () (? :id))) |
| 386 | (t (parser () :id))))) |
| 387 | |
| 388 | (labels ((qualifiers () |
| 389 | ;; qualifier* |
| 390 | |
| 391 | (parse |
| 392 | (seq ((quals (list () |
| 393 | (scan-simple-declspec |
| 394 | scanner |
| 395 | :indicator :qualifier |
| 396 | :predicate (lambda (ds) |
| 397 | (and (typep ds 'declspec) |
| 398 | (eq (ds-kind ds) |
| 399 | 'qualifier))))))) |
| 400 | (mapcar #'ds-label quals)))) |
| 401 | |
| 402 | (disallow-keyword-functions (type) |
| 403 | (when (typep type 'c-keyword-function-type) |
| 404 | (error "Functions with keyword arguments are only ~ |
| 405 | allowed at top-level"))) |
| 406 | |
| 407 | (star () |
| 408 | ;; Prefix: `*' qualifiers |
| 409 | |
| 410 | (parse (seq (#\* (quals (qualifiers))) |
| 411 | (preop "*" (state 9) |
| 412 | (cons (lambda (type) |
| 413 | (disallow-keyword-functions type) |
| 414 | (funcall (car state) |
| 415 | (make-pointer-type type quals))) |
| 416 | (cdr state)))))) |
| 417 | |
| 418 | (predict-argument-list-p () |
| 419 | ;; See `prefix-lparen'. Predict an argument list rather |
| 420 | ;; than a nested declarator if (a) abstract declarators are |
| 421 | ;; permitted and (b) the next token is a declaration |
| 422 | ;; specifier or ellipsis. |
| 423 | (let ((type (token-type scanner)) |
| 424 | (value (token-value scanner))) |
| 425 | (and abstractp |
| 426 | (or (eq type :ellipsis) |
| 427 | (and (eq type :id) |
| 428 | (or (gethash value *module-type-map*) |
| 429 | (gethash value *declspec-map*))))))) |
| 430 | |
| 431 | (prefix-lparen () |
| 432 | ;; Prefix: `(' |
| 433 | ;; |
| 434 | ;; Opening parentheses are treated as prefix operators by |
| 435 | ;; the expression parsing engine. There's an annoying |
| 436 | ;; ambiguity in the syntax if abstract declarators are |
| 437 | ;; permitted: a `(' might be either the start of a nested |
| 438 | ;; subdeclarator or the start of a postfix function argument |
| 439 | ;; list. The two are disambiguated by stating that if the |
| 440 | ;; token following the `(' is a `)' or a declaration |
| 441 | ;; specifier, then we have a postfix argument list. |
| 442 | (parse |
| 443 | (peek (seq (#\( |
| 444 | (nil (if (predict-argument-list-p) |
| 445 | (values nil nil nil) |
| 446 | (values t t nil)))) |
| 447 | (lparen #\)))))) |
| 448 | |
| 449 | (kernel () |
| 450 | (parse (seq ((name (funcall kernel-parser))) |
| 451 | (cons #'identity name)))) |
| 452 | |
| 453 | (arg-decl (abstractp) |
| 454 | (parse (seq ((base-type (parse-c-type scanner)) |
| 455 | (dtor (parse-declarator scanner base-type |
| 456 | :abstractp abstractp))) |
| 457 | dtor))) |
| 458 | |
| 459 | (argument () |
| 460 | ;; argument ::= type abstract-declspec |
| 461 | |
| 462 | (parse (seq ((dtor (arg-decl t))) |
| 463 | (make-argument (cdr dtor) (car dtor))))) |
| 464 | |
| 465 | (kw-argument () |
| 466 | ;; kw-argument ::= type declspec [= c-fragment] |
| 467 | |
| 468 | (parse (seq ((dtor (arg-decl nil)) |
| 469 | (dflt (? (when (eq (token-type scanner) #\=) |
| 470 | (parse-delimited-fragment |
| 471 | scanner #\= '(#\, #\)) |
| 472 | :keep-end t))))) |
| 473 | (make-argument (cdr dtor) (car dtor) dflt)))) |
| 474 | |
| 475 | (argument-list () |
| 476 | ;; argument-list ::= |
| 477 | ;; [argument [`,' argument]* [`,' argument-tail]] |
| 478 | ;; | argument-tail |
| 479 | ;; |
| 480 | ;; argument-tail ::= `...' | keyword-tail |
| 481 | ;; |
| 482 | ;; keyword-tail ::= `?' [kw-argument [`,' kw-argument]*] |
| 483 | ;; |
| 484 | ;; kw-argument ::= argument [= c-fragment] |
| 485 | ;; |
| 486 | ;; The possibility of a trailing `,' `...' means that we |
| 487 | ;; can't use the standard `list' parser. Note that, unlike |
| 488 | ;; `real' C, we allow an ellipsis even if there are no |
| 489 | ;; explicit arguments. |
| 490 | |
| 491 | (let ((args nil) |
| 492 | (keys nil) |
| 493 | (keysp nil)) |
| 494 | (loop |
| 495 | (when (eq (token-type scanner) :ellipsis) |
| 496 | (push :ellipsis args) |
| 497 | (scanner-step scanner) |
| 498 | (return)) |
| 499 | (when (and keywordp (eq (token-type scanner) #\?)) |
| 500 | (setf keysp t) |
| 501 | (scanner-step scanner) |
| 502 | (multiple-value-bind (arg winp consumedp) |
| 503 | (parse (list (:min 0) (kw-argument) #\,)) |
| 504 | (declare (ignore consumedp)) |
| 505 | (unless winp |
| 506 | (return-from argument-list (values arg nil t))) |
| 507 | (setf keys arg) |
| 508 | (return))) |
| 509 | (multiple-value-bind (arg winp consumedp) |
| 510 | (argument) |
| 511 | (unless winp |
| 512 | (if (or consumedp args) |
| 513 | (return-from argument-list (values arg nil t)) |
| 514 | (return))) |
| 515 | (push arg args)) |
| 516 | (unless (eq (token-type scanner) #\,) |
| 517 | (return)) |
| 518 | (scanner-step scanner)) |
| 519 | (values (let ((rargs (nreverse args)) |
| 520 | (rkeys (nreverse keys))) |
| 521 | (if keysp |
| 522 | (lambda (ret) |
| 523 | (make-keyword-function-type |
| 524 | ret rargs rkeys)) |
| 525 | (lambda (ret) |
| 526 | (make-function-type ret rargs)))) |
| 527 | t |
| 528 | (or args keysp)))) |
| 529 | |
| 530 | (postfix-lparen () |
| 531 | ;; Postfix: `(' argument-list `)' |
| 532 | |
| 533 | (parse (seq (#\( (make (argument-list)) #\)) |
| 534 | (postop "()" (state 10) |
| 535 | (cons (lambda (type) |
| 536 | (disallow-keyword-functions type) |
| 537 | (funcall (car state) |
| 538 | (funcall make type))) |
| 539 | (cdr state)))))) |
| 540 | |
| 541 | (dimension () |
| 542 | ;; `[' c-fragment ']' |
| 543 | |
| 544 | (parse (seq ((frag (parse-delimited-fragment |
| 545 | scanner #\[ #\]))) |
| 546 | (c-fragment-text frag)))) |
| 547 | |
| 548 | (lbracket () |
| 549 | ;; Postfix: dimension+ |
| 550 | |
| 551 | (parse (seq ((dims (list (:min 1) (dimension)))) |
| 552 | (postop "[]" (state 10) |
| 553 | (cons (lambda (type) |
| 554 | (disallow-keyword-functions type) |
| 555 | (funcall (car state) |
| 556 | (make-array-type type dims))) |
| 557 | (cdr state))))))) |
| 558 | |
| 559 | ;; And now we actually do the declarator parsing. |
| 560 | (parse (seq ((value (expr (:nestedp nestedp) |
| 561 | |
| 562 | ;; An actual operand. |
| 563 | (kernel) |
| 564 | |
| 565 | ;; Binary operators. There aren't any. |
| 566 | nil |
| 567 | |
| 568 | ;; Prefix operators. |
| 569 | (or (star) |
| 570 | (prefix-lparen)) |
| 571 | |
| 572 | ;; Postfix operators. |
| 573 | (or (postfix-lparen) |
| 574 | (lbracket) |
| 575 | (when nestedp (seq (#\)) (rparen #\)))))))) |
| 576 | (cons (wrap-c-type (lambda (type) |
| 577 | (funcall (car value) type)) |
| 578 | base-type) |
| 579 | (cdr value)))))))) |
| 580 | |
| 581 | ;;;----- That's all, folks -------------------------------------------------- |