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
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
c-type
c-array-type
c-function-type
+ c-storage-specifiers-type
qualifiable-c-type
c-atomic-type
c-pointer-type
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
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
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
(eql short) t
(eql signed-char) t
(eql size-t) t
+ (eql specs) t
(eql struct) t
(eql unsigned) t
(eql unsigned-char) t
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
\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 @<subtype> is the actual
+ type, and may be any C type; the @<specifiers> are a list of
+ storage-specifier objects.
+
+ The type specifier @|(specs @<subtype> @<specifier>^*)| wraps the
+ @<subtype> in a @|c-storage-specifiers-type|, carrying the @<specifier>s,
+ which are a list of storage specifiers in S-expression notation.
+\end{describe}
+
+\begin{describe}{fun}{c-type-specifiers @<type> @> @<list>}
+ Returns the list of type specifiers attached to the @<type> object, which
+ must be a @|c-storage-specifiers-type|.
+\end{describe}
+
+\begin{describe}{mac}
+ {define-c-storage-specifier-syntax @<name> @<lambda-list> \\ \ind
+ @[[ @<declaration>^* @! @<doc-string> @]] \\
+ @<form>^* \-
+ \nlret @<name>}
+
+ Defines the symbol @<name> as a new storage-specifier operator. When a
+ list of the form @|(@<name> @<argument>^*)| is used as a storage specifier,
+ the @<argument>s are bound to fresh variables according to the
+ @<lambda-list> (a destructuring lambda-list) and the @<form>s evaluated in
+ order in the resulting lexical environment as an implicit @<progn>. The
+ value should be a Lisp form which will evaluate to the storage-specifier
+ object described by the arguments.
+
+ The @<form>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 @<spec> @> @<form>}
+ Returns the Lisp form that @<spec> expands to within @|(c-type (specs
+ @<subtype> @<spec>))|.
+
+ If @<spec> is a list, then \descref{expand-c-storage-specifier-form} is
+ invoked.
+\end{describe}
+
+\begin{describe}{gf}{expand-c-storage-specifier-form @<spec> @> @<form>}
+ Returns the Lisp form that @|(@<head> . @<tail>)| expands to within
+ @|(c-type (specs @<subtype> (@<head> . @<tail>)))|.
+\end{describe}
+
+\begin{describe}{gf}{pprint-c-storage-specifier @<spec> @<stream>}
+\end{describe}
+
+\begin{describe}{gf}
+ {print-c-storage-specifier @<stream> @<spec>
+ \&optional @<colon> @<atsign>}
+\end{describe}
+
+\begin{describe}{fun}{wrap-c-type @<func> @<base-type> @> @<c-type>}
+ Apply @<func> to the underlying C type of @<base-type> to create a new
+ `wrapped' type, and attach the storage specifiers of @<base-type> to the
+ wrapped type.
+
+ If @<base-type> is \emph{not} a @|c-storage-specifiers-type|, then return
+ @|(funcall @<func> @<base-type>)|. Otherwise, return a new
+ @|c-storage-specifiers-type|, with the same specifiers, but whose subtype
+ is the result of applying @<func> to the subtype of the original
+ @<base-type>.
+\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.
(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 "~:@<SPECS ~@_~:I~/sod:print-c-type/~
+ ~{ ~_~/sod:print-c-storage-specifier/~}~:>"
+ (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.
;; 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))
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)
(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.
((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)))
(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.
(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 --------------------------------------------------
(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 / sod / commitdiff