+++ /dev/null
-;;; -*-lisp-*-
-;;;
-;;; Parser for C types
-;;;
-;;; (c) 2009 Straylight/Edgeware
-;;;
-
-;;;----- Licensing notice ---------------------------------------------------
-;;;
-;;; This file is part of the Sensble Object Design, an object system for C.
-;;;
-;;; SOD is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 2 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; SOD is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with SOD; if not, write to the Free Software Foundation,
-;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-(cl:in-package #:sod)
-
-;;;--------------------------------------------------------------------------
-;;; Declaration specifiers.
-;;;
-;;; This stuff is distressingly complicated.
-;;;
-;;; Parsing a (single) declaration specifier is quite easy, and a declaration
-;;; is just a sequence of these things. Except that there are a stack of
-;;; rules about which ones are allowed to go together, and the language
-;;; doesn't require them to appear in any particular order.
-;;;
-;;; A collection of declaration specifiers is carried about in a purpose-made
-;;; object with a number of handy operations defined on it, and then I build
-;;; some parsers in terms of them. The basic strategy is to parse
-;;; declaration specifiers while they're valid, and keep track of what we've
-;;; read. When I've reached the end, we'll convert what we've got into a
-;;; `canonical form', and then convert that into a C type object of the
-;;; appropriate kind. The whole business is rather more complicated than it
-;;; really ought to be.
-
-;; Firstly, a table of interesting things about the various declaration
-;; specifiers that I might encounter. I categorize declaration specifiers
-;; into four kinds.
-;;
-;; * `Type specifiers' describe the actual type, whether that's integer,
-;; character, floating point, or some tagged or user-named type.
-;;
-;; * `Size specifiers' distinguish different sizes of the same basic type.
-;; This is how we tell the difference between `int' and `long'.
-;;
-;; * `Sign specifiers' distinguish different signednesses. This is how we
-;; tell the difference between `int' and `unsigned'.
-;;
-;; * `Qualifiers' are our old friends `const', `restrict' and `volatile'.
-;;
-;; These groupings are for my benefit here, in determining whether a
-;; particular declaration specifier is valid in the current context. I don't
-;; accept `function specifiers' (of which the only current example is
-;; `inline') since it's meaningless to me.
-
-(defclass declspec ()
- ;; This could have been done with DEFSTRUCT just as well, but a DEFCLASS
- ;; can be tweaked interactively, which is a win at the moment.
- ((label :type keyword :initarg :label :reader ds-label)
- (name :type string :initarg :name :reader ds-name)
- (kind :type (member type sign size qualifier)
- :initarg :kind :reader ds-kind)
- (taggedp :type boolean :initarg :taggedp
- :initform nil :reader ds-taggedp))
- (:documentation
- "Represents the important components of a declaration specifier.
-
- The only interesting instances of this class are in the table
- `*declspec-map*'."))
-
-(defmethod shared-initialize :after ((ds declspec) slot-names &key)
- "If no name is provided then derive one from the label.
-
- Most declaration specifiers have simple names for which this works well."
- (default-slot (ds 'name slot-names)
- (string-downcase (ds-label ds))))
-
-(defparameter *declspec-map*
- (let ((map (make-hash-table :test #'equal)))
- (dolist (item '((type :void :char :int :float :double)
- ((type :taggedp t) :enum :struct :union)
- (size :short :long (:long-long :name "long long"))
- (sign :signed :unsigned)
- (qualifier :const :restrict :volatile)))
- (destructuring-bind (kind &key (taggedp nil))
- (let ((spec (car item)))
- (if (consp spec) spec (list spec)))
- (dolist (spec (cdr item))
- (destructuring-bind (label
- &key
- (name (string-downcase label))
- (taggedp taggedp))
- (if (consp spec) spec (list spec))
- (let ((ds (make-instance 'declspec
- :label label
- :name name
- :kind kind
- :taggedp taggedp)))
- (setf (gethash name map) ds
- (gethash label map) ds))))))
- map)
- "Maps symbolic labels and textual names to DECLSPEC instances.")
-
-;; A collection of declaration specifiers, and how to merge them together.
-
-(defclass declspecs ()
- ;; Despite the fact that it looks pretty trivial, this can't be done with
- ;; DEFCLASS for the simple reason that we add more methods to the accessor
- ;; functions later.
- ((type :initform nil :initarg :type :reader ds-type)
- (sign :initform nil :initarg :sign :reader ds-sign)
- (size :initform nil :initarg :size :reader ds-size)
- (qualifier :initform nil :initarg :qualifiers :reader ds-qualifiers))
- (:documentation
- "Represents a collection of declaration specifiers.
-
- This is used during type parsing to represent the type under
- construction. Instances are immutable: we build new ones rather than
- modifying existing ones. This leads to a certain amount of churn, but
- we'll just have to live with that.
-
- (Why are instances immutable? Because it's much easier to merge a new
- specifier into an existing collection, and then check that the resulting
- thing is valid rather than having to deal with all of the possible
- special cases of what the new thing might be. And if the merged
- collection isn't good, I must roll back to the previous version. So I
- don't get to take advantage of a mutable structure.)"))
-
-(defmethod ds-label ((ty c-type)) :c-type)
-(defmethod ds-name ((ty c-type)) (princ-to-string ty))
-(defmethod ds-kind ((ty c-type)) 'type)
-
-(defparameter *good-declspecs*
- '(((:int) (:signed :unsigned) (:short :long :long-long))
- ((:char) (:signed :unsigned) ())
- ((:double) () (:long))
- (t () ()))
- "List of good collections of declaration specifiers.
-
- Each item is a list of the form (TYPES SIGNS SIZES). Each of TYPES, SIGNS
- and SIZES is either a list of acceptable specifiers of the appropriate
- kind, or T, which matches any specifier.")
-
-(defun good-declspecs-p (specs)
- "Are SPECS a good collection of declaration specifiers?"
- (let ((speclist (list (ds-type specs) (ds-sign specs) (ds-size specs))))
- (some (lambda (it)
- (every (lambda (spec pat)
- (or (eq pat t) (null spec)
- (member (ds-label spec) pat)))
- speclist it))
- *good-declspecs*)))
-
-(defun combine-declspec (specs ds)
- "Combine the declspec DS with the existing SPECS.
-
- Returns new DECLSPECS if they're OK, or `nil' if not. The old SPECS are
- not modified."
-
- (let* ((kind (ds-kind ds))
- (old (slot-value specs kind)))
- (multiple-value-bind (ok new)
- (case kind
- (qualifier (values t (adjoin ds old)))
- (size (cond ((not old) (values t ds))
- ((and (eq (ds-label old) :long) (eq ds old))
- (values t (gethash :long-long *declspec-map*)))
- (t (values nil nil))))
- (t (values (not old) ds)))
- (if ok
- (let ((copy (copy-instance specs)))
- (setf (slot-value copy kind) new)
- (and (good-declspecs-p copy) copy))
- nil))))
-
-(defun declspecs-type (specs)
- "Convert `declspecs' SPECS into a standalone C type object."
- (let ((type (ds-type specs))
- (size (ds-size specs))
- (sign (ds-sign specs))
- (quals (mapcar #'ds-label (ds-qualifiers specs))))
- (cond ((typep type 'c-type)
- (qualify-c-type type quals))
- ((or type size sign)
- (when (and sign (eq (ds-label sign) :signed)
- (eq (ds-label type) :int))
- (setf sign nil))
- (cond ((and (or (null type) (eq (ds-label type) :int))
- (or size sign))
- (setf type nil))
- ((null type)
- (setf type (gethash :int *declspec-map*))))
- (make-simple-type (format nil "~{~@[~A~^ ~]~}"
- (mapcar #'ds-label
- (remove nil
- (list sign size type))))
- quals))
- (t
- nil))))
-
-;; Parsing declaration specifiers.
-
-(define-indicator :declspec "<declaration-specifier>")
-
-(defun scan-declspec
- (scanner &key (predicate (constantly t)) (indicator :declspec))
- "Scan a DECLSPEC from SCANNER.
-
- If PREDICATE is provided then only succeed if (funcall PREDICATE DECLSPEC)
- is true, where DECLSPEC is the raw declaration specifier or C-type object,
- so we won't have fetched the tag for a tagged type yet. If the PREDICATE
- returns false then the scan fails without consuming input.
-
- If we couldn't find an acceptable declaration specifier then issue
- INDICATOR as the failure indicator. Value on success is either a
- `declspec' object or a `c-type' object."
-
- ;; Turns out to be easier to do this by hand.
- (let ((ds (and (eq (token-type scanner) :id)
- (let ((kw (token-value scanner)))
- (or (gethash kw *module-type-map*)
- (gethash kw *declspec-map*))))))
- (cond ((or (not ds) (and predicate (not (funcall predicate ds))))
- (values (list indicator) nil nil))
- ((ds-taggedp ds)
- (scanner-step scanner)
- (if (eq (token-type scanner) :id)
- (let ((ty (make-c-tagged-type (ds-label ds)
- (token-value scanner))))
- (scanner-step scanner)
- (values ty t t))
- (values :tag nil t)))
- (t
- (scanner-step scanner)
- (values ds t t)))))
-
-(defun scan-and-merge-declspec (scanner specs)
- "Scan a declaration specifier and merge it with SPECS.
-
- This is a parser function. If it succeeds, it returns the merged
- `declspecs' object. It can fail either if no valid declaration specifier
- is found or it cannot merge the declaration specifier with the existing
- SPECS."
-
- (with-parser-context (token-scanner-context :scanner scanner)
- (if-parse (:consumedp consumedp) (scan-declspec scanner)
- (aif (combine-declspec specs it)
- (values it t consumedp)
- (values (list :declspec) nil consumedp)))))
-
-(defun parse-c-type (scanner)
- "Parse a C type from declaration specifiers.
-
- This is a parser function. If it succeeds then the result is a `c-type'
- object representing the type it found. Note that this function won't try
- to parse a C declarator."
-
- (with-parser-context (token-scanner-context :scanner scanner)
- (if-parse (:result specs :consumedp cp)
- (many (specs (make-instance 'declspecs) it :min 1)
- (peek (scan-and-merge-declspec scanner specs)))
- (let ((type (declspecs-type specs)))
- (if type (values type t cp)
- (values (list :declspec) nil cp))))))
-
-;;;--------------------------------------------------------------------------
-;;; Parsing declarators.
-;;;
-;;; The syntax of declaration specifiers was horrific. Declarators are a
-;;; very simple expression syntax, but this time the semantics are awful. In
-;;; particular, they're inside-out. If <> denotes mumble of foo, then op <>
-;;; is something like mumble of op of foo. Unfortunately, the expression
-;;; parser engine wants to apply op of mumble of foo, so I'll have to do some
-;;; work to fix the impedance mismatch.
-;;;
-;;; The currency we'll use is a pair (FUNC . NAME), with the semantics that
-;;; (funcall FUNC TYPE) returns the derived type. The result of
-;;; `parse-declarator' will be of this form.
-
-(defun parse-declarator (scanner base-type &key abstractp)
- (with-parser-context (token-scanner-context :scanner scanner)
-
- (labels ((qualifiers ()
- ;; QUALIFIER*
-
- (parse
- (seq ((quals (list ()
- (scan-declspec
- scanner
- :indicator :qualifier
- :predicate (lambda (ds)
- (and (typep ds 'declspec)
- (eq (ds-kind ds)
- 'qualifier)))))))
- (mapcar #'ds-label quals))))
-
- (star ()
- ;; Prefix: `*' QUALIFIERS
-
- (parse (seq (#\* (quals (qualifiers)))
- (preop "*" (state 9)
- (cons (lambda (type)
- (funcall (car state)
- (make-pointer-type type quals)))
- (cdr state))))))
-
- (prefix-lparen ()
- ;; Prefix: `('
- ;;
- ;; Opening parentheses are treated as prefix operators by the
- ;; expression parsing engine. There's an annoying ambiguity
- ;; in the syntax if abstract declarators are permitted: a `('
- ;; might be either the start of a nested subdeclarator or the
- ;; start of a postfix function argument list. The two are
- ;; disambiguated by stating that if the token following the
- ;; `(' is a `)' or a declaration specifier, then we have a
- ;; postfix argument list.
-
- (parse
- (peek (seq (#\(
- (nil (if (and abstractp
- (eq (token-type scanner) :id)
- (let ((id (token-value scanner)))
- (or (gethash id
- *module-type-map*)
- (gethash id
- *declspec-map*))))
- (values nil nil nil)
- (values t t nil))))
- (lparen #\))))))
-
- (centre ()
- ;; ID | empty
- ;;
- ;; The centre might be empty or contain an identifier,
- ;; depending on the setting of ABSTRACTP.
-
- (parse (or (when (not (eq abstractp t))
- (seq ((id :id)) (cons #'identity id)))
- (when abstractp
- (t (cons #'identity nil))))))
-
- (argument-list ()
- ;; [ ARGUMENT [ `,' ARGUMENT ]* ]
-
- (parse (list ()
- (seq ((base-type (parse-c-type scanner))
- (dtor (parse-declarator scanner
- base-type
- :abstractp :maybe)))
- (make-argument (cdr dtor) (car dtor)))
- #\,)))
-
- (postfix-lparen ()
- ;; Postfix: `(' ARGUMENT-LIST `)'
-
- (parse (seq (#\( (args (argument-list)) #\))
- (postop "()" (state 9)
- (cons (lambda (type)
- (funcall (car state)
- (make-function-type type args)))
- (cdr state))))))
-
- (dimension ()
- ;; `[' C-FRAGMENT ']'
-
- (parse-delimited-fragment scanner #\[ #\]))
-
- (lbracket ()
- ;; Postfix: DIMENSION+
-
- (parse (seq ((dims (list (:min 1) (dimension))))
- (postop "[]" (state 10)
- (cons (lambda (type)
- (funcall (car state)
- (make-array-type type dims)))
- (cdr state)))))))
-
- ;; And now we actually do the declarator parsing.
- (parse (seq ((value (expr (:nestedp nestedp)
-
- ;; An actual operand.
- (centre)
-
- ;; Binary operators. There aren't any.
- nil
-
- ;; Prefix operators.
- (or (star)
- (prefix-lparen))
-
- ;; Postfix operators.
- (or (postfix-lparen)
- (lbracket)
- (when nestedp (seq (#\)) (rparen #\))))))))
- (cons (funcall (car value) base-type) (cdr value)))))))
-
-;;;----- That's all, folks --------------------------------------------------
~mdw / sod / blobdiff