chiark - git - mdw - sod/blob - 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)
  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 (defmethod ds-label ((ty c-type)) :c-type)
 124 (defmethod ds-name ((ty c-type)) (princ-to-string ty))
 125 (defmethod ds-kind ((ty c-type)) 'type)
 126
 127 ;; A collection of declaration specifiers, and how to merge them together.
 128
 129 (defclass declspecs ()
 130   ;; This could have been done with `defstruct' just as well, but a
 131   ;; `defclass' can be tweaked interactively, which is a win at the moment.
 132   ((type :initform nil :initarg :type :reader ds-type)
 133    (complexity :initform nil :initarg :complexity :reader ds-complexity)
 134    (sign :initform nil :initarg :sign :reader ds-sign)
 135    (size :initform nil :initarg :size :reader ds-size)
 136    (qualifier :initform nil :initarg :qualifiers :reader ds-qualifiers))
 137   (:documentation "Represents a collection of declaration specifiers.
 138
 139    This is used during type parsing to represent the type under construction.
 140    Instances are immutable: we build new ones rather than modifying existing
 141    ones.  This leads to a certain amount of churn, but we'll just have to
 142    live with that.
 143
 144    (Why are instances immutable?  Because it's much easier to merge a new
 145    specifier into an existing collection and then check that the resulting
 146    thing is valid, rather than having to deal with all of the possible
 147    special cases of what the new thing might be.  And if the merged
 148    collection isn't good, I must roll back to the previous version.  So I
 149    don't get to take advantage of a mutable structure.)"))
 150
 151 (defparameter *good-declspecs*
 152   '(((:int) (:signed :unsigned) (:short :long :long-long) ())
 153     ((:char) (:signed :unsigned) () ())
 154     ((:double) () (:long) (:complex :imaginary))
 155     (t () () ()))
 156   "List of good collections of declaration specifiers.
 157
 158    Each item is a list of the form (TYPES SIGNS SIZES COMPLEXITIES).  Each of
 159    TYPES, SIGNS, SIZES, and COMPLEXITIES, is either a list of acceptable
 160    specifiers of the appropriate kind, or T, which matches any specifier.")
 161
 162 (defun good-declspecs-p (specs)
 163   "Are SPECS a good collection of declaration specifiers?"
 164   (let ((speclist (list (ds-type specs)
 165                         (ds-sign specs)
 166                         (ds-size specs)
 167                         (ds-complexity specs))))
 168     (some (lambda (it)
 169             (every (lambda (spec pat)
 170                      (or (eq pat t) (null spec)
 171                          (member (ds-label spec) pat)))
 172                    speclist it))
 173           *good-declspecs*)))
 174
 175 (defun combine-declspec (specs ds)
 176   "Combine the declspec DS with the existing SPECS.
 177
 178    Returns new DECLSPECS if they're OK, or `nil' if not.  The old SPECS are
 179    not modified."
 180
 181   (let* ((kind (ds-kind ds))
 182          (old (slot-value specs kind)))
 183     (multiple-value-bind (ok new)
 184         (case kind
 185           (qualifier (values t (adjoin ds old)))
 186           (size (cond ((not old) (values t ds))
 187                       ((and (eq (ds-label old) :long) (eq ds old))
 188                        (values t (gethash :long-long *declspec-map*)))
 189                       (t (values nil nil))))
 190           (t (values (not old) ds)))
 191       (if ok
 192           (let ((copy (copy-instance specs)))
 193             (setf (slot-value copy kind) new)
 194             (and (good-declspecs-p copy) copy))
 195           nil))))
 196
 197 (defun declspecs-type (specs)
 198   "Convert `declspecs' SPECS into a standalone C type object."
 199   (let ((type (ds-type specs))
 200         (size (ds-size specs))
 201         (sign (ds-sign specs))
 202         (cplx (ds-complexity specs))
 203         (quals (mapcar #'ds-label (ds-qualifiers specs))))
 204     (cond ((typep type 'c-type)
 205            (qualify-c-type type quals))
 206           ((or type size sign cplx)
 207            (when (and sign (eq (ds-label sign) :signed)
 208                       (eq (ds-label type) :int))
 209              (setf sign nil))
 210            (cond ((and (or (null type) (eq (ds-label type) :int))
 211                        (or size sign))
 212                   (setf type nil))
 213                  ((null type)
 214                   (setf type (gethash :int *declspec-map*))))
 215            (make-simple-type (format nil "~{~@[~A~^ ~]~}"
 216                                      (mapcar #'ds-name
 217                                              (remove nil
 218                                                      (list sign cplx
 219                                                            size type))))
 220                              quals))
 221           (t
 222            nil))))
 223
 224 ;; Parsing declaration specifiers.
 225
 226 (define-indicator :declspec "<declaration-specifier>")
 227
 228 (defun scan-simple-declspec
 229     (scanner &key (predicate (constantly t)) (indicator :declspec))
 230   "Scan a simple `declspec' from SCANNER.
 231
 232    Simple declspecs are the ones defined in the `*declspec-map*' or
 233    `*module-type-map*'.  This covers the remaining possibilities if the
 234    `complex-declspec' pluggable parser didn't find anything to match.
 235
 236    If PREDICATE is provided then only succeed if (funcall PREDICATE DECLSPEC)
 237    is true, where DECLSPEC is the raw declaration specifier or C-type object,
 238    so we won't have fetched the tag for a tagged type yet.  If the PREDICATE
 239    returns false then the scan fails without consuming input.
 240
 241    If we couldn't find an acceptable declaration specifier then issue
 242    INDICATOR as the failure indicator.  Value on success is either a
 243    `declspec' object or a `c-type' object."
 244
 245   ;; Turns out to be easier to do this by hand.
 246   (let ((ds (and (eq (token-type scanner) :id)
 247                  (let ((kw (token-value scanner)))
 248                    (or (and (boundp '*module-type-map*)
 249                             (gethash kw *module-type-map*))
 250                        (gethash kw *declspec-map*))))))
 251     (cond ((or (not ds) (and predicate (not (funcall predicate ds))))
 252            (values (list indicator) nil nil))
 253           ((and (typep ds 'declspec) (ds-taggedp ds))
 254            (scanner-step scanner)
 255            (if (eq (token-type scanner) :id)
 256                (let ((ty (make-c-tagged-type (ds-label ds)
 257                                              (token-value scanner))))
 258                  (scanner-step scanner)
 259                  (values ty t t))
 260                (values :tag nil t)))
 261           (t
 262            (scanner-step scanner)
 263            (values ds t t)))))
 264
 265 (define-pluggable-parser complex-declspec atomic-typepsec (scanner)
 266   ;; `atomic' `(' type-name `)'
 267   ;; `_Atomic' `(' type-name `)'
 268   (with-parser-context (token-scanner-context :scanner scanner)
 269     (parse (peek (seq ((nil (or "atomic" "_Atomic"))
 270                        #\(
 271                        (decls (parse-c-type scanner))
 272                        (subtype (parse-declarator scanner decls
 273                                                   :kernel (parse-empty)
 274                                                   :abstractp t))
 275                        #\))
 276                    (make-atomic-type (car subtype)))))))
 277
 278 (defun scan-and-merge-declspec (scanner specs)
 279   "Scan a declaration specifier and merge it with SPECS.
 280
 281    This is a parser function.  If it succeeds, it returns the merged
 282    `declspecs' object.  It can fail either if no valid declaration specifier
 283    is found or it cannot merge the declaration specifier with the existing
 284    SPECS."
 285
 286   (with-parser-context (token-scanner-context :scanner scanner)
 287     (if-parse (:consumedp consumedp)
 288               (or (plug complex-declspec scanner)
 289                   (scan-simple-declspec scanner))
 290       (aif (combine-declspec specs it)
 291            (values it t consumedp)
 292            (values (list :declspec) nil consumedp)))))
 293
 294 (export 'parse-c-type)
 295 (defun parse-c-type (scanner)
 296   "Parse a C type from declaration specifiers.
 297
 298    This is a parser function.  If it succeeds then the result is a `c-type'
 299    object representing the type it found.  Note that this function won't try
 300    to parse a C declarator."
 301
 302   (with-parser-context (token-scanner-context :scanner scanner)
 303     (if-parse (:result specs :consumedp cp)
 304               (many (specs (make-instance 'declspecs) it :min 1)
 305                 (peek (scan-and-merge-declspec scanner specs)))
 306               (let ((type (declspecs-type specs)))
 307                 (if type (values type t cp)
 308                     (values (list :declspec) nil cp))))))
 309
 310 ;;;--------------------------------------------------------------------------
 311 ;;; Parsing declarators.
 312 ;;;
 313 ;;; The syntax of declaration specifiers was horrific.  Declarators are a
 314 ;;; very simple expression syntax, but this time the semantics are awful.  In
 315 ;;; particular, they're inside-out.  If <> denotes mumble of foo, then op <>
 316 ;;; is something like mumble of op of foo.  Unfortunately, the expression
 317 ;;; parser engine wants to apply op of mumble of foo, so I'll have to do some
 318 ;;; work to fix the impedance mismatch.
 319 ;;;
 320 ;;; The currency we'll use is a pair (FUNC . NAME), with the semantics that
 321 ;;; (funcall FUNC TYPE) returns the derived type.  The result of
 322 ;;; `parse-declarator' will be of this form.
 323
 324 (export 'parse-declarator)
 325 (defun parse-declarator (scanner base-type &key kernel abstractp)
 326   "Parse a C declarator, returning a pair (C-TYPE . NAME).
 327
 328    The SCANNER is a token scanner to read from.  The BASE-TYPE is the type
 329    extracted from the preceding declaration specifiers, as parsed by
 330    `parse-c-type'.
 331
 332    The result contains both the resulting constructed C-TYPE (with any
 333    qualifiers etc. as necessary), and the name from the middle of the
 334    declarator.  The name is parsed using the KERNEL parser provided, and
 335    defaults to matching a simple identifier `:id'.  This might, e.g., be
 336    (? :id) to parse an `abstract declarator' which has optional names.
 337
 338    There's an annoying ambiguity in the syntax, if an empty KERNEL is
 339    permitted.  In this case, you must ensure that ABSTRACTP is true so that
 340    the appropriate heuristic can be applied.  As a convenience, if ABSTRACTP
 341    is true then `(? :id)' is used as the default KERNEL."
 342   (with-parser-context (token-scanner-context :scanner scanner)
 343     (let ((kernel-parser (cond (kernel kernel)
 344                                (abstractp (parser () (? :id)))
 345                                (t (parser () :id)))))
 346
 347       (labels ((qualifiers ()
 348                  ;; qualifier*
 349
 350                  (parse
 351                    (seq ((quals (list ()
 352                                   (scan-simple-declspec
 353                                    scanner
 354                                    :indicator :qualifier
 355                                    :predicate (lambda (ds)
 356                                                 (and (typep ds 'declspec)
 357                                                      (eq (ds-kind ds)
 358                                                          'qualifier)))))))
 359                      (mapcar #'ds-label quals))))
 360
 361                (star ()
 362                  ;; Prefix: `*' qualifiers
 363
 364                  (parse (seq (#\* (quals (qualifiers)))
 365                           (preop "*" (state 9)
 366                             (cons (lambda (type)
 367                                     (funcall (car state)
 368                                              (make-pointer-type type quals)))
 369                                   (cdr state))))))
 370
 371                (predict-argument-list-p ()
 372                  ;; See `prefix-lparen'.  Predict an argument list rather
 373                  ;; than a nested declarator if (a) abstract declarators are
 374                  ;; permitted and (b) the next token is a declaration
 375                  ;; specifier or ellipsis.
 376                  (let ((type (token-type scanner))
 377                        (value (token-value scanner)))
 378                    (and abstractp
 379                         (or (eq type :ellipsis)
 380                             (and (eq type :id)
 381                                  (or (gethash value *module-type-map*)
 382                                      (gethash value *declspec-map*)))))))
 383
 384                (prefix-lparen ()
 385                  ;; Prefix: `('
 386                  ;;
 387                  ;; Opening parentheses are treated as prefix operators by
 388                  ;; the expression parsing engine.  There's an annoying
 389                  ;; ambiguity in the syntax if abstract declarators are
 390                  ;; permitted: a `(' might be either the start of a nested
 391                  ;; subdeclarator or the start of a postfix function argument
 392                  ;; list.  The two are disambiguated by stating that if the
 393                  ;; token following the `(' is a `)' or a declaration
 394                  ;; specifier, then we have a postfix argument list.
 395                  (parse
 396                    (peek (seq (#\(
 397                                (nil (if (predict-argument-list-p)
 398                                         (values nil nil nil)
 399                                         (values t t nil))))
 400                            (lparen #\))))))
 401
 402                (kernel ()
 403                  (parse (seq ((name (funcall kernel-parser)))
 404                           (cons #'identity name))))
 405
 406                (argument-list ()
 407                  ;; [argument [`,' argument]* [`,' `...']] | `...'
 408                  ;;
 409                  ;; The possibility of a trailing `,' `...' means that we
 410                  ;; can't use the standard `list' parser.  Note that, unlike
 411                  ;; `real' C, we allow an ellipsis even if there are no
 412                  ;; explicit arguments.
 413
 414                  (let ((args nil))
 415                    (loop
 416                      (when (eq (token-type scanner) :ellipsis)
 417                        (push :ellipsis args)
 418                        (scanner-step scanner)
 419                        (return))
 420                      (multiple-value-bind (arg winp consumedp)
 421                          (parse (seq ((base-type (parse-c-type scanner))
 422                                       (dtor (parse-declarator scanner
 423                                                               base-type
 424                                                               :abstractp t)))
 425                                   (make-argument (cdr dtor) (car dtor))))
 426                        (unless winp
 427                          (if (or consumedp args)
 428                              (return-from argument-list (values arg nil t))
 429                              (return)))
 430                        (push arg args))
 431                      (unless (eq (token-type scanner) #\,)
 432                        (return))
 433                      (scanner-step scanner))
 434                    (values (nreverse args) t args)))
 435
 436                (postfix-lparen ()
 437                  ;; Postfix: `(' argument-list `)'
 438
 439                  (parse (seq (#\( (args (argument-list)) #\))
 440                           (postop "()" (state 10)
 441                             (cons (lambda (type)
 442                                     (funcall (car state)
 443                                              (make-function-type type args)))
 444                                   (cdr state))))))
 445
 446                (dimension ()
 447                  ;; `[' c-fragment ']'
 448
 449                  (parse (seq ((frag (parse-delimited-fragment
 450                                      scanner #\[ #\])))
 451                           (c-fragment-text frag))))
 452
 453                (lbracket ()
 454                  ;; Postfix: dimension+
 455
 456                  (parse (seq ((dims (list (:min 1) (dimension))))
 457                           (postop "[]" (state 10)
 458                             (cons (lambda (type)
 459                                     (funcall (car state)
 460                                              (make-array-type type dims)))
 461                                   (cdr state)))))))
 462
 463         ;; And now we actually do the declarator parsing.
 464         (parse (seq ((value (expr (:nestedp nestedp)
 465
 466                               ;; An actual operand.
 467                               (kernel)
 468
 469                               ;; Binary operators.  There aren't any.
 470                               nil
 471
 472                               ;; Prefix operators.
 473                               (or (star)
 474                                   (prefix-lparen))
 475
 476                               ;; Postfix operators.
 477                               (or (postfix-lparen)
 478                                   (lbracket)
 479                                   (when nestedp (seq (#\)) (rparen #\))))))))
 480                  (cons (funcall (car value) base-type) (cdr value))))))))
 481
 482 ;;;----- That's all, folks --------------------------------------------------