X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~mdw/git/sod/blobdiff_plain/0e7cdea08f8c635a46e66bd0a96bb6f12b907bbc..ae0f15ee8427fa91cfd1945bfded847032cb8a25:/src/c-types-parse.lisp diff --git a/src/c-types-parse.lisp b/src/c-types-parse.lisp index 018c108..92f999a 100644 --- a/src/c-types-parse.lisp +++ b/src/c-types-parse.lisp @@ -70,15 +70,15 @@ (defclass declspec () ;; accessor functions later. ((label :type keyword :initarg :label :reader ds-label) (name :type string :initarg :name :reader ds-name) - (kind :type (member type sign size qualifier) + (kind :type (member type complexity 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*'.")) + 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. @@ -90,13 +90,14 @@ (default-slot (ds 'name slot-names) (defparameter *declspec-map* (let ((map (make-hash-table :test #'equal))) (dolist (item '((type :void :char :int :float :double - (:bool :name "_Bool")) - (complexity (:complex :name "_Complex") - (:imaginary :name "_Imaginary")) + (:bool :compat "_Bool")) + (complexity (:complex :compat "_Complex") + (:imaginary :compat "_Imaginary")) ((type :taggedp t) :enum :struct :union) (size :short :long (:long-long :name "long long")) (sign :signed :unsigned) - (qualifier :const :restrict :volatile))) + (qualifier :const :restrict :volatile + (:atomic :compat "_Atomic")))) (destructuring-bind (kind &key (taggedp nil)) (let ((spec (car item))) (if (consp spec) spec (list spec))) @@ -104,20 +105,25 @@ (defparameter *declspec-map* (destructuring-bind (label &key (name (string-downcase label)) + compat (taggedp taggedp)) (if (consp spec) spec (list spec)) (let ((ds (make-instance 'declspec :label label - :name name + :name (or compat name) :kind kind :taggedp taggedp))) (setf (gethash name map) ds - (gethash label map) ds)))))) - (dolist (label '(:complex :imaginary :bool)) - (setf (gethash (string-downcase label) map) (gethash label map))) + (gethash label map) ds) + (when compat + (setf (gethash compat map) ds))))))) map) "Maps symbolic labels and textual names to `declspec' instances.") +(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) + ;; A collection of declaration specifiers, and how to merge them together. (defclass declspecs () @@ -128,24 +134,19 @@ (defclass declspecs () (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. + (:documentation "Represents a collection of declaration specifiers. - (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.)")) + 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. -(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) + (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.)")) (defparameter *good-declspecs* '(((:int) (:signed :unsigned) (:short :long :long-long) ()) @@ -198,10 +199,11 @@ (defun declspecs-type (specs) (let ((type (ds-type specs)) (size (ds-size specs)) (sign (ds-sign specs)) + (cplx (ds-complexity specs)) (quals (mapcar #'ds-label (ds-qualifiers specs)))) (cond ((typep type 'c-type) (qualify-c-type type quals)) - ((or type size sign) + ((or type size sign cplx) (when (and sign (eq (ds-label sign) :signed) (eq (ds-label type) :int)) (setf sign nil)) @@ -213,7 +215,8 @@ (defun declspecs-type (specs) (make-simple-type (format nil "~{~@[~A~^ ~]~}" (mapcar #'ds-name (remove nil - (list sign size type)))) + (list sign cplx + size type)))) quals)) (t nil)))) @@ -222,9 +225,13 @@ (defun declspecs-type (specs) (define-indicator :declspec "") -(defun scan-declspec +(defun scan-simple-declspec (scanner &key (predicate (constantly t)) (indicator :declspec)) - "Scan a `declspec' from SCANNER. + "Scan a simple `declspec' from SCANNER. + + Simple declspecs are the ones defined in the `*declspec-map*' or + `*module-type-map*'. This covers the remaining possibilities if the + `complex-declspec' pluggable parser didn't find anything to match. If PREDICATE is provided then only succeed if (funcall PREDICATE DECLSPEC) is true, where DECLSPEC is the raw declaration specifier or C-type object, @@ -238,7 +245,8 @@ (defun scan-declspec ;; 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*) + (or (and (boundp '*module-type-map*) + (gethash kw *module-type-map*)) (gethash kw *declspec-map*)))))) (cond ((or (not ds) (and predicate (not (funcall predicate ds)))) (values (list indicator) nil nil)) @@ -254,6 +262,19 @@ (defun scan-declspec (scanner-step scanner) (values ds t t))))) +(define-pluggable-parser complex-declspec atomic-typepsec (scanner) + ;; `atomic' `(' type-name `)' + ;; `_Atomic' `(' type-name `)' + (with-parser-context (token-scanner-context :scanner scanner) + (parse (peek (seq ((nil (or "atomic" "_Atomic")) + #\( + (decls (parse-c-type scanner)) + (subtype (parse-declarator scanner decls + :kernel (parse-empty) + :abstractp t)) + #\)) + (make-atomic-type (car subtype))))))) + (defun scan-and-merge-declspec (scanner specs) "Scan a declaration specifier and merge it with SPECS. @@ -263,7 +284,9 @@ (defun scan-and-merge-declspec (scanner specs) SPECS." (with-parser-context (token-scanner-context :scanner scanner) - (if-parse (:consumedp consumedp) (scan-declspec scanner) + (if-parse (:consumedp consumedp) + (or (plug complex-declspec scanner) + (scan-simple-declspec scanner)) (aif (combine-declspec specs it) (values it t consumedp) (values (list :declspec) nil consumedp))))) @@ -326,7 +349,7 @@ (defun parse-declarator (scanner base-type &key kernel abstractp) (parse (seq ((quals (list () - (scan-declspec + (scan-simple-declspec scanner :indicator :qualifier :predicate (lambda (ds)