X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/b2983f3591981a916f748362d91ff0e2817552cb..f64eb323a5798e155cc494043f5f750abf50a482:/src/c-types-parse.lisp diff --git a/src/c-types-parse.lisp b/src/c-types-parse.lisp index 6a622b7..6f5db4d 100644 --- a/src/c-types-parse.lisp +++ b/src/c-types-parse.lisp @@ -70,15 +70,15 @@ ;; accessor functions later. ((label :type keyword :initarg :label :reader ds-label) (name :type string :initarg :name :reader ds-name) - (kind :type (member type complexity sign size qualifier) + (kind :type (member type complexity sign size qualifier specs) :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 @@ (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,32 @@ (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.") +(defclass storespec () + ((spec :initarg :spec :reader ds-spec)) + (:documentation "Carrier for a storage specifier.")) + +(defmethod ds-label ((spec storespec)) spec) +(defmethod ds-kind ((spec storespec)) 'specs) + +(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 () @@ -127,25 +140,21 @@ (complexity :initform nil :initarg :complexity :reader ds-complexity) (sign :initform nil :initarg :sign :reader ds-sign) (size :initform nil :initarg :size :reader ds-size) + (specs :initform nil :initarg :specs :reader ds-specs) (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) ()) @@ -186,6 +195,7 @@ ((and (eq (ds-label old) :long) (eq ds old)) (values t (gethash :long-long *declspec-map*))) (t (values nil nil)))) + (specs (values t (adjoin (ds-spec ds) old))) (t (values (not old) ds))) (if ok (let ((copy (copy-instance specs))) @@ -195,38 +205,46 @@ (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)) - (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 cplx) - (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-name - (remove nil - (list sign cplx - size type)))) - quals)) - (t - nil)))) + (let* ((base-type (ds-type specs)) + (size (ds-size specs)) + (sign (ds-sign specs)) + (cplx (ds-complexity specs)) + (quals (mapcar #'ds-label (ds-qualifiers specs))) + (specs (ds-specs specs)) + (type (cond ((typep base-type 'c-type) + (qualify-c-type base-type quals)) + ((or base-type size sign cplx) + (when (and sign (eq (ds-label sign) :signed) + (eq (ds-label base-type) :int)) + (setf sign nil)) + (cond ((and (or (null base-type) + (eq (ds-label base-type) :int)) + (or size sign)) + (setf base-type nil)) + ((null base-type) + (setf base-type (gethash :int *declspec-map*)))) + (let* ((things (list sign cplx size base-type)) + (stripped (remove nil things)) + (names (mapcar #'ds-name stripped))) + (make-simple-type (format nil "~{~A~^ ~}" names) + quals))) + (t + nil)))) + (cond ((null type) nil) + ((null specs) type) + (t (make-storage-specifiers-type type specs))))) ;; Parsing declaration specifiers. (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, @@ -257,6 +275,34 @@ (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))))))) + +(define-pluggable-parser complex-declspec alignas (scanner) + ;; `alignas' `(' fragment `)' + ;; `_Alignas' `(' fragment `)' + (with-parser-context (token-scanner-context :scanner scanner) + (parse (peek (seq ((nil (or "alignas" "_Alignas")) + (nil (lisp (values #\( + (eq (token-type scanner) #\() + nil))) + (nil (commit)) + (frag (parse-delimited-fragment scanner #\( #\)))) + (make-instance 'storespec + :spec (make-instance + 'alignas-storage-specifier + :alignment frag))))))) + (defun scan-and-merge-declspec (scanner specs) "Scan a declaration specifier and merge it with SPECS. @@ -266,7 +312,9 @@ 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))))) @@ -342,7 +390,7 @@ (parse (seq ((quals (list () - (scan-declspec + (scan-simple-declspec scanner :indicator :qualifier :predicate (lambda (ds) @@ -525,6 +573,9 @@ (or (postfix-lparen) (lbracket) (when nestedp (seq (#\)) (rparen #\)))))))) - (cons (funcall (car value) base-type) (cdr value)))))))) + (cons (wrap-c-type (lambda (type) + (funcall (car value) type)) + base-type) + (cdr value)))))))) ;;;----- That's all, folks --------------------------------------------------