From 14adef2f3c2a0a80be0ca2e1a364256812203bd8 Mon Sep 17 00:00:00 2001 Message-Id: <14adef2f3c2a0a80be0ca2e1a364256812203bd8.1716596049.git.mdw@distorted.org.uk> From: Mark Wooding Date: Thu, 26 May 2016 09:26:09 +0100 Subject: [PATCH] src/c-types-impl.lisp: Make string -> simple-c-type mapping more useful. Organization: Straylight/Edgeware From: Mark Wooding * Arrange for `define-simple-c-type' to accept multiple C type-name strings, and keep records in the `*simple-type-map*' allowing simple type names to be canonified. * Add a new function `find-simple-c-type' to retrieve the appropriate type object given one its names. * Use this when looking up types in property values. * Remove the type declarations from the builtin module because they're all entered as simple types directly now. --- doc/SYMBOLS | 1 + doc/clang.tex | 23 +++++++++++++++++------ src/builtin.lisp | 2 -- src/c-types-impl.lisp | 23 +++++++++++++++++------ src/pset-impl.lisp | 2 +- 5 files changed, 36 insertions(+), 15 deletions(-) diff --git a/doc/SYMBOLS b/doc/SYMBOLS index 74dbead..e167b03 100644 --- a/doc/SYMBOLS +++ b/doc/SYMBOLS @@ -70,6 +70,7 @@ c-types-impl.lisp double-complex c-type double-imaginary c-type enum c-type + find-simple-c-type function cl:float function class c-type float-complex c-type float-imaginary c-type diff --git a/doc/clang.tex b/doc/clang.tex index c4a6a53..ebe9d4e 100644 --- a/doc/clang.tex +++ b/doc/clang.tex @@ -565,23 +565,34 @@ In Sod, the leaf types are \begin{describe}{mac} {define-simple-c-type - \=@{ @ @! (@^+) @} @ \+\\ + \=@{ @ @! (@^+) @} + @{ @ @! (@^*) @} \+\\ @[[ @|:export| @ @]] \-\nlret @} Define type specifiers for a new simple C type. Each symbol @ is defined as a symbolic type specifier for the (unique interned) simple C - type whose name is the value of @. Further, each @ is - defined to be a type operator: the type specifier @|(@ + type whose name is the value of (the first) @. Further, each + @ is defined to be a type operator: the type specifier @|(@ @^*)| evaluates to the (unique interned) simple C type whose - name is @ and which has the @ (which are evaluated). + name is (the first) @ and which has the @ (which are + evaluated). - Furthermore, a variable @|c-type-@| is defined, for the first @ - only, and initialized with the newly constructed C type object. + Each of the @s is associated with the resulting type for retrieval + by \descref{find-simple-c-type}{fun}. Furthermore, a variable + @|c-type-@| is defined, for the first @ only, and initialized + with the newly constructed C type object. If @ is true, then the @|c-type-@| variable name, and all of the @s, are exported from the current package. \end{describe} +\begin{describe}{fun} + {find-simple-c-type @ @> @{ @ @! @|nil| @}} + If @ is the name of a simple C type, as established by the + \descref{define-simple-c-type}[macro]{mac}, then return the corresponding + @|simple-c-type| object; otherwise, return @|nil|. +\end{describe} + \begin{describe}{cls}{tagged-c-type (qualifiable-c-type) \&key :qualifiers :tag} Provides common behaviour for C tagged types. A @ is a string diff --git a/src/builtin.lisp b/src/builtin.lisp index 0787b8d..9707578 100644 --- a/src/builtin.lisp +++ b/src/builtin.lisp @@ -564,8 +564,6 @@ (defun make-builtin-module () :case :common) :state nil))) (with-module-environment (module) - (dolist (name '("va_list" "size_t" "ptrdiff_t" "wchar_t")) - (add-to-module module (make-instance 'type-item :name name))) (flet ((header-name (name) (concatenate 'string "\"" (string-downcase name) ".h\"")) (add-includes (reason &rest names) diff --git a/src/c-types-impl.lisp b/src/c-types-impl.lisp index 7884518..dfb23e6 100644 --- a/src/c-types-impl.lisp +++ b/src/c-types-impl.lisp @@ -226,12 +226,23 @@ (defmethod expand-c-type-form ((head string) tail) (export 'define-simple-c-type) (defmacro define-simple-c-type (names type &key export) "Define each of NAMES to be a simple type called TYPE." - (let ((names (if (listp names) names (list names)))) - `(progn - (setf (gethash ,type *simple-type-map*) ',(car names)) - (defctype ,names ,type :export ,export) - (define-c-type-syntax ,(car names) (&rest quals) - `(make-simple-type ,',type (list ,@quals)))))) + (let ((names (if (listp names) names (list names))) + (types (if (listp type) type (list type)))) + (with-gensyms (type name) + `(progn + (dolist (,type ',types) + (setf (gethash ,type *simple-type-map*) ',(car names))) + (dolist (,name ',names) + (setf (gethash ,name *simple-type-map*) ,(car types))) + (defctype ,names ,(car types) :export ,export) + (define-c-type-syntax ,(car names) (&rest quals) + `(make-simple-type ,',(car types) (list ,@quals))))))) + +(export 'find-simple-c-type) +(defun find-simple-c-type (name) + "Return the `simple-c-type' with the given NAME, or nil." + (aand (gethash name *simple-type-map*) + (make-simple-type (gethash it *simple-type-map*)))) ;; Built-in C types. diff --git a/src/pset-impl.lisp b/src/pset-impl.lisp index baa3830..ecad712 100644 --- a/src/pset-impl.lisp +++ b/src/pset-impl.lisp @@ -71,7 +71,7 @@ (defmethod coerce-property-value ((value string) (type (eql :id)) (wanted (eql :type))) (or (and (boundp '*module-type-map*) (gethash value *module-type-map*)) - (gethash value *declspec-map*) + (find-simple-c-type value) (error "Unknown type `~A'." value))) ;;;-------------------------------------------------------------------------- -- [mdw]