X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/b6f84c5704b54f0393144d8a0753a69158437cc0..97d10f8b1f631cd32ea5ac9118b253cb4142d391:/src/c-types-impl.lisp

diff --git a/src/c-types-impl.lisp b/src/c-types-impl.lisp
index 7884518..6b7c904 100644
--- a/src/c-types-impl.lisp
+++ b/src/c-types-impl.lisp
@@ -226,12 +226,23 @@
 (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.
 
@@ -265,7 +276,7 @@
 (define-simple-c-type double "double" :export t)
 (define-simple-c-type long-double "long double" :export t)
 
-(define-simple-c-type bool "_Bool" :export t)
+(define-simple-c-type bool ("_Bool" "bool") :export t)
 
 (define-simple-c-type float-complex "float _Complex" :export t)
 (define-simple-c-type double-complex "double _Complex" :export t)
@@ -317,7 +328,7 @@
 	       `(progn
 		  (export '(,type ,kind ,constructor))
 		  (defclass ,type (tagged-c-type) ()
-		    (:documentation ,(format nil "C ~a types." what)))
+		    (:documentation ,(format nil "C ~A types." what)))
 		  (defmethod c-tagged-type-kind ((type ,type))
 		    ',keyword)
 		  (defmethod kind-c-tagged-type ((kind (eql ',keyword)))
@@ -574,7 +585,7 @@
 	(let ((this-name (argument-name this))
 	      (prev-name (argument-name prev)))
 	  (when (string= this-name prev-name)
-	    (error "Duplicate keyword argument name `~A'." this-name)))))
+	    (error "Duplicate keyword argument name `~A'" this-name)))))
     list))
 
 (export 'merge-keyword-lists)
@@ -616,7 +627,7 @@
 		       (other-what (cdr other-item)))
 		  (unless (c-type-equal-p type other-type)
 		    (error "Type mismatch for keyword argument `~A': ~
-			    ~A~@[ (~A)~] doesn't match ~A~@[ (~A)~]."
+			    ~A~@[ (~A)~] doesn't match ~A~@[ (~A)~]"
 			   name
 			   type what
 			   other-type other-what))))))))