src/c-types-impl.lisp: Make string -> simple-c-type mapping more useful.

  * 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.

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index 74dbead437c07e7aeab66f443531d41f4a761c5e..e167b0307db49a33beed7dd42d75edcfab245651 100644 (file)
--- 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 c4a6a531bcd597e5c75e6d6ebca746954c21b7aa..ebe9d4e2db069cede474b2fcf0ff1edd9531a93c 100644 (file)
--- 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
-       \=@{ @<name> @! (@<name>^+) @} @<string>               \+\\
+       \=@{ @<name> @! (@<name>^+) @}
+         @{ @<string> @! (@<string>^*) @}                     \+\\
          @[[ @|:export| @<export-flag> @]]
       \-\nlret @<name>}
   Define type specifiers for a new simple C type.  Each symbol @<name> is
   defined as a symbolic type specifier for the (unique interned) simple C
-  type whose name is the value of @<string>.  Further, each @<name> is
-  defined to be a type operator: the type specifier @|(@<name>
+  type whose name is the value of (the first) @<string>.  Further, each
+  @<name> is defined to be a type operator: the type specifier @|(@<name>
   @<qualifier>^*)| evaluates to the (unique interned) simple C type whose
-  name is @<string> and which has the @<qualifiers> (which are evaluated).
+  name is (the first) @<string> and which has the @<qualifiers> (which are
+  evaluated).
 
-  Furthermore, a variable @|c-type-@<name>| is defined, for the first @<name>
-  only, and initialized with the newly constructed C type object.
+  Each of the @<string>s is associated with the resulting type for retrieval
+  by \descref{find-simple-c-type}{fun}.  Furthermore, a variable
+  @|c-type-@<name>| is defined, for the first @<name> only, and initialized
+  with the newly constructed C type object.
 
   If @<export-flag> is true, then the @|c-type-@<name>| variable name, and
   all of the @<name>s, are exported from the current package.
 \end{describe}
 
+\begin{describe}{fun}
+    {find-simple-c-type @<string> @> @{ @<simple-c-type> @! @|nil| @}}
+  If @<string> 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 @<tag> is a string

diff --git a/src/builtin.lisp b/src/builtin.lisp
index 0787b8dec7ccee1ef79a47a86899f4172e1bcfbb..97075785ee569b5e695ae527ee5a7da7612021b3 100644 (file)
--- 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 788451836272a46ec5a889581ce8a29d432bf071..dfb23e659192e047e079cf62e240201836aa604a 100644 (file)
--- 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 baa38303cf4d22325dec4f273625496603fd3a8d..ecad71236fe61a3e354d1219cac63faa963ad8ac 100644 (file)
--- 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)))
 
 ;;;--------------------------------------------------------------------------