From b7fcf94152e4c1938fbca55d13b1e6a64b694bd6 Mon Sep 17 00:00:00 2001 Message-Id: From: Mark Wooding Date: Thu, 26 May 2016 09:26:09 +0100 Subject: [PATCH] src/c-types-{proto,impl,parse}.lisp: Add `storage specifiers' to the model. Organization: Straylight/Edgeware From: Mark Wooding A slightly unusual kind of thing. This is intended to capture things like storage classes and similar which are determinedly `top level', unlike qualifiers which stay attached to the base type in the presence of declarator operators. Storage specifiers are attached to a special carrier type `c-storage-specifiers-type' (with all of the necessary trimmings), and there is new machinery (`wrap-c-type') to arrange that this stays at the outermost level when deriving new types from existing ones. There is a pile of additional protocol, mostly mirroring the main types protocol, for dealing with storage-specifier syntax, in both Lisp and C. --- doc/SYMBOLS | 28 ++++++++++++++ doc/clang.tex | 81 +++++++++++++++++++++++++++++++++++++++ src/c-types-impl.lisp | 40 +++++++++++++++++++ src/c-types-parse.lisp | 68 ++++++++++++++++++++------------- src/c-types-proto.lisp | 87 ++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 278 insertions(+), 26 deletions(-) diff --git a/doc/SYMBOLS b/doc/SYMBOLS index 8395db3..022538a 100644 --- a/doc/SYMBOLS +++ b/doc/SYMBOLS @@ -113,6 +113,7 @@ c-types-impl.lisp size-t c-type sllong c-type slong c-type + specs c-type sshort c-type cl:string function class c-type opthandler struct c-type @@ -149,26 +150,34 @@ c-types-proto.lisp argumentp function c-name-case function c-qualifier-keyword generic + c-storage-specifiers-type class c-type macro class c-type-alias macro c-type-equal-p generic c-type-qualifier-keywords function c-type-qualifiers generic c-type-space function + c-type-specifiers generic c-type-subtype generic canonify-qualifiers function commentify-argument-name generic defctype macro + define-c-storage-specifier-syntax macro define-c-type-syntax macro + expand-c-storage-specifier generic + expand-c-storage-specifier-form generic expand-c-type-form generic expand-c-type-spec generic format-qualifiers function make-argument function maybe-in-parens macro + pprint-c-storage-specifier generic pprint-c-type generic + print-c-storage-specifier generic print-c-type generic qualifiable-c-type class qualify-c-type generic + wrap-c-type function class-finalize-impl.lisp c3-cpl function @@ -588,6 +597,7 @@ cl:t c-type c-array-type c-function-type + c-storage-specifiers-type qualifiable-c-type c-atomic-type c-pointer-type @@ -706,6 +716,8 @@ c-type-equal-p c-class-type c-class-type c-function-type c-function-type c-pointer-type c-pointer-type + c-storage-specifiers-type c-type + c-type c-storage-specifiers-type qualifiable-c-type qualifiable-c-type simple-c-type simple-c-type tagged-c-type tagged-c-type @@ -713,11 +725,14 @@ c-type-name simple-c-type c-type-qualifiers qualifiable-c-type +c-type-specifiers + c-storage-specifiers-type c-type-subtype c-array-type c-atomic-type c-function-type c-pointer-type + c-storage-specifiers-type c-type-tag tagged-c-type chain-offset-chain-head @@ -874,6 +889,11 @@ ensure-sequencer-item sequencer t ensure-var sod::basic-codegen t t +expand-c-storage-specifier + cl:list + cl:symbol +expand-c-storage-specifier-form + (eql sod-parser:lisp) t expand-c-type-form (eql cl:*) t (eql cl:array) t @@ -906,6 +926,7 @@ expand-c-type-form (eql short) t (eql signed-char) t (eql size-t) t + (eql specs) t (eql struct) t (eql unsigned) t (eql unsigned-char) t @@ -1176,23 +1197,30 @@ module-name module module-pset module +pprint-c-storage-specifier + cl:symbol t pprint-c-type t t t c-array-type t t c-atomic-type t t c-function-type t t c-pointer-type t t + c-storage-specifiers-type t t simple-c-type t t tagged-c-type t t primary-method-class simple-message standard-message +print-c-storage-specifier + t cl:symbol + t t print-c-type t c-array-type t c-atomic-type t c-class-type t c-function-type t c-pointer-type + t c-storage-specifiers-type t simple-c-type t tagged-c-type cl:print-object diff --git a/doc/clang.tex b/doc/clang.tex index 348c5b6..5a22984 100644 --- a/doc/clang.tex +++ b/doc/clang.tex @@ -385,6 +385,87 @@ methods to \descref{c-qualifier-keyword}{gf}. \end{describe} +\subsection{Storage specifiers} \label{sec:clang.ctypes.specs} + +Some declaration specifiers, mostly to do with how to store the specific +object in question, are determinedly `top level', and, unlike qualifiers, +don't stay attached to the base type when acted on by declarator operators. +Sod calls these `storage specifiers', though no such category exists in the C +standard. They have their own protocol, which is similar in many ways to +that of C types. + +Every Lisp keyword is potentially a storage specifier, which simply maps to +its lower-case print name in C; but other storage specifiers may be more +complicated objects. + +\begin{describe}{cls} + {c-storage-specifiers-type (c-type) \&key :subtype :specifiers} + A type which carries storage specifiers. The @ is the actual + type, and may be any C type; the @ are a list of + storage-specifier objects. + + The type specifier @|(specs @ @^*)| wraps the + @ in a @|c-storage-specifiers-type|, carrying the @s, + which are a list of storage specifiers in S-expression notation. +\end{describe} + +\begin{describe}{fun}{c-type-specifiers @ @> @} + Returns the list of type specifiers attached to the @ object, which + must be a @|c-storage-specifiers-type|. +\end{describe} + +\begin{describe}{mac} + {define-c-storage-specifier-syntax @ @ \\ \ind + @[[ @^* @! @ @]] \\ + @
^* \- + \nlret @} + + Defines the symbol @ as a new storage-specifier operator. When a + list of the form @|(@ @^*)| is used as a storage specifier, + the @s are bound to fresh variables according to the + @ (a destructuring lambda-list) and the @s evaluated in + order in the resulting lexical environment as an implicit @. The + value should be a Lisp form which will evaluate to the storage-specifier + object described by the arguments. + + The @s may call @|expand-c-storage-specifier| in order to recursively + expand storage specifiers among its arguments. +\end{describe} + +\begin{describe}{gf}{expand-c-storage-specifier @ @> @} + Returns the Lisp form that @ expands to within @|(c-type (specs + @ @))|. + + If @ is a list, then \descref{expand-c-storage-specifier-form} is + invoked. +\end{describe} + +\begin{describe}{gf}{expand-c-storage-specifier-form @ @> @} + Returns the Lisp form that @|(@ . @)| expands to within + @|(c-type (specs @ (@ . @)))|. +\end{describe} + +\begin{describe}{gf}{pprint-c-storage-specifier @ @} +\end{describe} + +\begin{describe}{gf} + {print-c-storage-specifier @ @ + \&optional @ @} +\end{describe} + +\begin{describe}{fun}{wrap-c-type @ @ @> @} + Apply @ to the underlying C type of @ to create a new + `wrapped' type, and attach the storage specifiers of @ to the + wrapped type. + + If @ is \emph{not} a @|c-storage-specifiers-type|, then return + @|(funcall @ @)|. Otherwise, return a new + @|c-storage-specifiers-type|, with the same specifiers, but whose subtype + is the result of applying @ to the subtype of the original + @. +\end{describe} + + \subsection{Leaf types} \label{sec:clang.c-types.leaf} A \emph{leaf type} is a type which is not defined in terms of another type. diff --git a/src/c-types-impl.lisp b/src/c-types-impl.lisp index d0d4a74..719e610 100644 --- a/src/c-types-impl.lisp +++ b/src/c-types-impl.lisp @@ -95,6 +95,46 @@ (defmethod qualify-c-type ((type qualifiable-c-type) qualifiers) (append qualifiers (c-type-qualifiers type))) initargs))) +;;;-------------------------------------------------------------------------- +;;; Storage specifiers. + +(defmethod c-type-equal-p :around + ((type-a c-storage-specifiers-type) (type-b c-type)) + "Ignore storage specifiers when comparing C types." + (c-type-equal-p (c-type-subtype type-a) type-b)) + +(defmethod c-type-equal-p :around + ((type-a c-type) (type-b c-storage-specifiers-type)) + "Ignore storage specifiers when comparing C types." + (c-type-equal-p type-a (c-type-subtype type-b))) + +(defun make-storage-specifiers-type (subtype specifiers) + "Construct a type based on SUBTYPE, carrying the storage SPECIFIERS." + (if (null specifiers) subtype + (make-or-intern-c-type 'c-storage-specifiers-type subtype + :specifiers specifiers + :subtype subtype))) + +(defmethod pprint-c-type ((type c-storage-specifiers-type) stream kernel) + (dolist (spec (c-type-specifiers type)) + (pprint-c-storage-specifier spec stream) + (write-char #\space stream) + (pprint-newline :miser stream)) + (pprint-c-type (c-type-subtype type) stream kernel)) + +(defmethod print-c-type + (stream (type c-storage-specifiers-type) &optional colon atsign) + (declare (ignore colon atsign)) + (format stream "~:@" + (c-type-subtype type) (c-type-specifiers type))) + +(export 'specs) +(define-c-type-syntax specs (subtype &rest specifiers) + `(make-storage-specifiers-type + ,(expand-c-type-spec subtype) + (list ,@(mapcar #'expand-c-storage-specifier specifiers)))) + ;;;-------------------------------------------------------------------------- ;;; Simple C types. diff --git a/src/c-types-parse.lisp b/src/c-types-parse.lisp index 92f999a..94e8687 100644 --- a/src/c-types-parse.lisp +++ b/src/c-types-parse.lisp @@ -70,7 +70,7 @@ (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 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)) @@ -120,6 +120,13 @@ (defparameter *declspec-map* 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) @@ -133,6 +140,7 @@ (defclass declspecs () (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. @@ -187,6 +195,7 @@ (defun combine-declspec (specs ds) ((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))) @@ -196,30 +205,34 @@ (defun combine-declspec (specs ds) (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. @@ -477,6 +490,9 @@ (defun parse-declarator (scanner base-type &key kernel abstractp) (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 -------------------------------------------------- diff --git a/src/c-types-proto.lisp b/src/c-types-proto.lisp index 1057321..0c95d02 100644 --- a/src/c-types-proto.lisp +++ b/src/c-types-proto.lisp @@ -245,6 +245,93 @@ (defun c-name-case (name) (error "Bad character in C name ~S." name)))))) (t name))) +;;;-------------------------------------------------------------------------- +;;; Storage specifier protocol. + +(export 'pprint-c-storage-specifier) +(defgeneric pprint-c-storage-specifier (spec stream) + (:documentation "Print the storage specifier SPEC to STREAM, as C syntax.") + (:method ((spec symbol) stream) (princ (string-downcase spec) stream))) + +(export 'print-c-storage-specifier) +(defgeneric print-c-storage-specifier (stream spec &optional colon atsign) + (:documentation + "Print the storage specifier SPEC to STREAM, as an S-expression. + + This function is suitable for use in `format's ~/.../ command.") + (:method (stream (spec t) &optional colon atsign) + (declare (ignore colon atsign)) + (prin1 spec stream)) + (:method (stream (spec symbol) &optional colon atsign) + (declare (ignore colon atsign)) + (princ (string-downcase spec) stream))) + +(export '(expand-c-storage-specifier expand-c-storage-specifier-form)) +(eval-when (:compile-toplevel :load-toplevel :execute) + (defgeneric expand-c-storage-specifier (spec) + (:documentation + "Expand SPEC into Lisp code to construct a storage specifier.") + (:method ((spec list)) + (expand-c-storage-specifier-form (car spec) (cdr spec))) + (:method ((spec symbol)) + (if (keywordp spec) spec + (expand-c-storage-specifier-form spec nil)))) + (defgeneric expand-c-storage-specifier-form (head tail) + (:documentation + "Expand a C storage-specifier form beginning with HEAD.") + (:method ((name (eql 'lisp)) tail) + `(progn ,@tail)))) + +(export 'define-c-storage-specifier-syntax) +(defmacro define-c-storage-specifier-syntax (name bvl &body body) + "Define a C storage-specifier syntax function. + + A function defined by BODY and with lambda-list BVL is associated wth the + NAME. When `expand-c-storage-specifier' sees a list (NAME . STUFF), it + will call this function with the argument list STUFF." + (with-gensyms (head tail) + (multiple-value-bind (doc decls body) (parse-body body) + `(eval-when (:compile-toplevel :load-toplevel :execute) + (defmethod expand-c-storage-specifier-form + ((,head (eql ',name)) ,tail) + ,@doc + (destructuring-bind ,bvl ,tail + ,@decls + (block ,name ,@body))) + ',name)))) + +;;;-------------------------------------------------------------------------- +;;; A type for carrying storage specifiers. + +(export '(c-storage-specifiers-type c-type-specifiers)) +(defclass c-storage-specifiers-type (c-type) + ((specifiers :initarg :specifiers :type list :reader c-type-specifiers) + (subtype :initarg :subtype :type c-type :reader c-type-subtype)) + (:documentation + "A type for carrying storage specifiers. + + Properly, storage specifiers should only appear on an outermost type. + This fake C type is a handy marker for the presence of storage specifiers, + so that they can be hoisted properly when constructing derived types.")) + +(export 'wrap-c-type) +(defun wrap-c-type (wrapper-func base-type) + "Handle storage specifiers correctly when making a derived type. + + WRAPPER-FUNC should be a function which will return some derived type of + BASE-TYPE. This function differs from `funcall' only when BASE-TYPE is + actually a `c-storage-specifiers-type', in which case it invokes + WRAPPER-FUNC on the underlying type, and re-attaches the storage + specifiers to the derived type." + (if (typep base-type 'c-storage-specifiers-type) + (let* ((unwrapped-type (c-type-subtype base-type)) + (wrapped-type (funcall wrapper-func unwrapped-type)) + (specifiers (c-type-specifiers base-type))) + (make-or-intern-c-type 'c-storage-specifiers-type unwrapped-type + :specifiers specifiers + :subtype wrapped-type)) + (funcall wrapper-func base-type))) + ;;;-------------------------------------------------------------------------- ;;; Function arguments. -- [mdw]