;;;--------------------------------------------------------------------------
;;; 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 tagged)
- :initarg :kind :reader ds-kind)))
+ (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))))
-(defclass declspecs ()
- ((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)))
-
(defparameter *declspec-map*
(let ((map (make-hash-table :test #'equal)))
(dolist (item '((type :void :char :int :float :double)
- (size :short :long (:long-long "long long"))
+ ((type :taggedp t) :enum :struct :union)
+ (size :short :long (:long-long :name "long long"))
(sign :signed :unsigned)
- (qualifier :const :restrict :volatile)
- (tagged :enum :struct :union)))
- (let ((kind (car item)))
+ (qualifier :const :restrict :volatile)))
+ (destructuring-bind (kind &key (taggedp nil))
+ (let ((spec (car item)))
+ (if (consp spec) spec (list spec)))
(dolist (spec (cdr item))
- (multiple-value-bind (label name)
- (if (consp spec)
- (values (car spec) (cadr spec))
- (values spec (string-downcase spec)))
+ (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)))
+ :label label
+ :name name
+ :kind kind
+ :taggedp taggedp)))
(setf (gethash name map) ds
(gethash label map) ds))))))
- map))
+ 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))
and SIZES is either a list of acceptable specifiers of the appropriate
kind, or T, which matches any specifier.")
-(defun scan-declspec (scanner)
- "Scan a DECLSPEC from SCANNER.
-
- 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 *declspec-map*)
- (gethash kw *module-type-map*))))))
- (cond ((not ds)
- (values (list :declspec) nil nil))
- ((eq (ds-kind ds) :tagged)
- (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 good-declspecs-p (specs)
"Are SPECS a good collection of declaration specifiers?"
(let ((speclist (list (ds-type specs) (ds-sign specs) (ds-size 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)
(and (good-declspecs-p copy) copy))
nil))))
-(defun scan-and-merge-declspec (scanner 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 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)))
- (cond ((or type size sign)
- (when (and (eq (ds-label sign) :signed)
+ (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))
(mapcar #'ds-label
(remove nil
(list sign size type))))
- (mapcar #'ds-label (ds-qualifiers specs))))
+ quals))
(t
nil))))
-(defun parse-c-type (scanner)
- (with-parser-context (token-scanner-context :scanner scanner)
- (if-parse (:result specs :consumedp cp)
- (many (specs (make-instance 'declspecs) it :min 1)
- (scan-and-merge-declspec scanner specs))
- (let ((type (declspecs-type specs)))
- (if type (values type t cp)
- (values (list :declspec) nil cp))))))
+;; 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)
- ;; This is rather complicated, but extracting all the guts into a structure
- ;; and passing it around makes matters worse rather than better.
- ;;
- ;; We 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 our benefit here, in determining whether a
- ;; particular declaration specifier is valid in the current context. We
- ;; don't accept `function specifiers' (of which the only current example is
- ;; `inline') since it's meaningless to us.
- ;;
- ;; Our basic strategy is to parse declaration specifiers while they're
- ;; valid, and keep track of what we've read. When we'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.
-
- (let ((specs (make-instance 'declspecs)))
-
-
- (let ((toks nil) (type nil) (size nil) (sign nil) (quals nil))
- (labels ((goodp (ty sg sz)
- "Are (TY SG SZ) a good set of declaration specifiers?"
- (some (lambda (it)
- (every (lambda (spec pat)
- (or (eq pat t) (eq spec nil)
- (member spec pat)))
- decls it))
- *good-declspecs*))
-
- (scan-declspec ()
- "Scan a declaration specifier."
- (flet ((win (value &optional (consumedp t))
- (when consumedp (scanner-step scanner))
- (return-from scan-declspec
- (values value t consumedp)))
- (lose (wanted &optional (consumedp nil))
- (values wanted nil consumedp)))
- (unless (eq (token-type scanner) :id) (lose :declspec))
- (let* ((id (token-value scanner))
- (ds (or (gethash id *declspec-map*)
- (gethash id *module-type-map*))))
- (unless ds (lose :declspec))
- (let ((label (ds-label ds)))
- (ecase (ds-kind ds)
- (:qualifier
- (push (ds-label ds) quals)
- (win ds))
- (:size
- (cond ((and (not size) (goodp type label sign))
- (setf size label)
- (win ds))
- (t
- (lose :declspec))))
- (:sign
- (cond ((and (not sign) (goodp type size label))
- (setf sign label)
- (win ds))
- (t
- (lose :declspec))))
- (:type
- (when (and (eq type :long) (eq label :long))
- (setf label :long-long))
- (cond ((and (or (not type) (eq type :long))
- (goodp label size sign))
- (setf type label)
- (win ds))
- (t
- (lose :declspec))))
- (:tagged
- (unless (and (not type) (goodp label size sign))
- (lose :declspec))
- (scanner-step scan)
- (unless (eq (token-type scanner) :id)
- (lose :tagged t))
- (setf type
- (make-c-tagged-type label
- (token-value scanner)))
- (win type))))))))
-
- (with-parser-context (token-scanner-context :scanner scanner)
- (many (nil nil nil :min 1)
- (scan-declspec))
-
-
-
-
- (let ((toks nil) (type nil) (size nil) (sign nil) (quals nil))
- (labels ((check (ty sz sg)
- (case ty
- ((nil :int) t)
- (:char (null sz))
- (:double (and (null sg) (or (null sz) (eq sz :long))))
- (t (and (null sg) (null sz)))))
- (set-type (ty)
- (when ))
- (set-size (sz)
- (when (and (eq sz :long) (eq size :long))
- (setf sz :long-long))
- (when (and (or (null size) (eq sz :long-long))
- (check type sz sign))
- (setf size sz)))
- (set-sign (sg)
- (when (and (null sign) (check type size sg))
- (setf sign sg)))
- (parse-declspec ()
- (multiple-value-bind (kind value)
- (categorize-declspec scanner)
- (if (ecase kind
- (:qualifier (push value quals))
- (:type (and (null type) (check value size sign)
- (setf type value)))
- (:size (let ((sz (if (and (eq size :long)
- (eq value :long))
- :long-long value)))
- (and (or (null size) (eq sz :long-long))
- (check type value sign)
- (setf size value))))
- (:sign (and (null sign) (check type size value)
- (setf sign value)))
-
+ (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