X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/bf090e021a5c20da452a4841cdfb8eb78e29544e..aa14a4cddcb96b681d5c19a2ec8bad382f43b264:/src/parse-c-types.lisp diff --git a/src/parse-c-types.lisp b/src/parse-c-types.lisp deleted file mode 100644 index ba6bf6f..0000000 --- a/src/parse-c-types.lisp +++ /dev/null @@ -1,409 +0,0 @@ -;;; -*-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 "") - -(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 --------------------------------------------------