chiark / gitweb /
src/method-impl.lisp: Initialize `suppliedp' flags properly.
[sod] / src / c-types-parse.lisp
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 :void :char :int :float :double
93                           (:bool :compat "_Bool"))
94                     (complexity (:complex :compat "_Complex")
95                                 (:imaginary :compat "_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                                (:atomic :compat "_Atomic"))))
101       (destructuring-bind (kind &key (taggedp nil))
102           (let ((spec (car item)))
103             (if (consp spec) spec (list spec)))
104         (dolist (spec (cdr item))
105           (destructuring-bind (label
106                                &key
107                                (name (string-downcase label))
108                                compat
109                                (taggedp taggedp))
110               (if (consp spec) spec (list spec))
111             (let ((ds (make-instance 'declspec
112                                      :label label
113                                      :name (or compat name)
114                                      :kind kind
115                                      :taggedp taggedp)))
116               (setf (gethash name map) ds
117                     (gethash label map) ds)
118               (when compat
119                 (setf (gethash compat map) ds)))))))
120     map)
121   "Maps symbolic labels and textual names to `declspec' instances.")
122
123 (defclass storespec ()
124   ((spec :initarg :spec :reader ds-spec))
125   (:documentation "Carrier for a storage specifier."))
126
127 (defmethod ds-label ((spec storespec)) spec)
128 (defmethod ds-kind ((spec storespec)) 'specs)
129
130 (defmethod ds-label ((ty c-type)) :c-type)
131 (defmethod ds-name ((ty c-type)) (princ-to-string ty))
132 (defmethod ds-kind ((ty c-type)) 'type)
133
134 ;; A collection of declaration specifiers, and how to merge them together.
135
136 (defclass declspecs ()
137   ;; This could have been done with `defstruct' just as well, but a
138   ;; `defclass' can be tweaked interactively, which is a win at the moment.
139   ((type :initform nil :initarg :type :reader ds-type)
140    (complexity :initform nil :initarg :complexity :reader ds-complexity)
141    (sign :initform nil :initarg :sign :reader ds-sign)
142    (size :initform nil :initarg :size :reader ds-size)
143    (specs :initform nil :initarg :specs :reader ds-specs)
144    (qualifier :initform nil :initarg :qualifiers :reader ds-qualifiers))
145   (:documentation "Represents a collection of declaration specifiers.
146
147    This is used during type parsing to represent the type under construction.
148    Instances are immutable: we build new ones rather than modifying existing
149    ones.  This leads to a certain amount of churn, but we'll just have to
150    live with that.
151
152    (Why are instances immutable?  Because it's much easier to merge a new
153    specifier into an existing collection and then check that the resulting
154    thing is valid, rather than having to deal with all of the possible
155    special cases of what the new thing might be.  And if the merged
156    collection isn't good, I must roll back to the previous version.  So I
157    don't get to take advantage of a mutable structure.)"))
158
159 (defparameter *good-declspecs*
160   '(((:int) (:signed :unsigned) (:short :long :long-long) ())
161     ((:char) (:signed :unsigned) () ())
162     ((:double) () (:long) (:complex :imaginary))
163     (t () () ()))
164   "List of good collections of declaration specifiers.
165
166    Each item is a list of the form (TYPES SIGNS SIZES COMPLEXITIES).  Each of
167    TYPES, SIGNS, SIZES, and COMPLEXITIES, is either a list of acceptable
168    specifiers of the appropriate kind, or T, which matches any specifier.")
169
170 (defun good-declspecs-p (specs)
171   "Are SPECS a good collection of declaration specifiers?"
172   (let ((speclist (list (ds-type specs)
173                         (ds-sign specs)
174                         (ds-size specs)
175                         (ds-complexity specs))))
176     (some (lambda (it)
177             (every (lambda (spec pat)
178                      (or (eq pat t) (null spec)
179                          (member (ds-label spec) pat)))
180                    speclist it))
181           *good-declspecs*)))
182
183 (defun combine-declspec (specs ds)
184   "Combine the declspec DS with the existing SPECS.
185
186    Returns new DECLSPECS if they're OK, or `nil' if not.  The old SPECS are
187    not modified."
188
189   (let* ((kind (ds-kind ds))
190          (old (slot-value specs kind)))
191     (multiple-value-bind (ok new)
192         (case kind
193           (qualifier (values t (adjoin ds old)))
194           (size (cond ((not old) (values t ds))
195                       ((and (eq (ds-label old) :long) (eq ds old))
196                        (values t (gethash :long-long *declspec-map*)))
197                       (t (values nil nil))))
198           (specs (values t (adjoin (ds-spec ds) old)))
199           (t (values (not old) ds)))
200       (if ok
201           (let ((copy (copy-instance specs)))
202             (setf (slot-value copy kind) new)
203             (and (good-declspecs-p copy) copy))
204           nil))))
205
206 (defun declspecs-type (specs)
207   "Convert `declspecs' SPECS into a standalone C type object."
208   (let* ((base-type (ds-type specs))
209          (size (ds-size specs))
210          (sign (ds-sign specs))
211          (cplx (ds-complexity specs))
212          (quals (mapcar #'ds-label (ds-qualifiers specs)))
213          (specs (ds-specs specs))
214          (type (cond ((typep base-type 'c-type)
215                       (qualify-c-type base-type quals))
216                      ((or base-type size sign cplx)
217                       (when (and sign (eq (ds-label sign) :signed)
218                                  (eq (ds-label base-type) :int))
219                         (setf sign nil))
220                       (cond ((and (or (null base-type)
221                                       (eq (ds-label base-type) :int))
222                                   (or size sign))
223                              (setf base-type nil))
224                             ((null base-type)
225                              (setf base-type (gethash :int *declspec-map*))))
226                       (let* ((things (list sign cplx size base-type))
227                              (stripped (remove nil things))
228                              (names (mapcar #'ds-name stripped)))
229                         (make-simple-type (format nil "~{~A~^ ~}" names)
230                                           quals)))
231                      (t
232                       nil))))
233     (cond ((null type) nil)
234           ((null specs) type)
235           (t (make-storage-specifiers-type type specs)))))
236
237 ;; Parsing declaration specifiers.
238
239 (define-indicator :declspec "<declaration-specifier>")
240
241 (defun scan-simple-declspec
242     (scanner &key (predicate (constantly t)) (indicator :declspec))
243   "Scan a simple `declspec' from SCANNER.
244
245    Simple declspecs are the ones defined in the `*declspec-map*' or
246    `*module-type-map*'.  This covers the remaining possibilities if the
247    `complex-declspec' pluggable parser didn't find anything to match.
248
249    If PREDICATE is provided then only succeed if (funcall PREDICATE DECLSPEC)
250    is true, where DECLSPEC is the raw declaration specifier or C-type object,
251    so we won't have fetched the tag for a tagged type yet.  If the PREDICATE
252    returns false then the scan fails without consuming input.
253
254    If we couldn't find an acceptable declaration specifier then issue
255    INDICATOR as the failure indicator.  Value on success is either a
256    `declspec' object or a `c-type' object."
257
258   ;; Turns out to be easier to do this by hand.
259   (let ((ds (and (eq (token-type scanner) :id)
260                  (let ((kw (token-value scanner)))
261                    (or (and (boundp '*module-type-map*)
262                             (gethash kw *module-type-map*))
263                        (gethash kw *declspec-map*))))))
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 --------------------------------------------------